home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Gamedisk3 / F.T.C / FTC.AMOS / FTC.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1993-06-22  |  65.4 KB  |  2,526 lines
  1. Set Buffer 60
  2. Break Off 
  3. Amos To Back : Amos Lock : Wait Vbl 
  4. On Error Goto GOTCHA
  5. MUS=1 : SOU=1
  6. Dim ICN(40,5),PL$(3,1),PL(3,35),F(3,39,24),F2(39,24),IN(3,15,2)
  7. Dim MON$(11),WET$(6),PRO$(4),EH$(4),AN$(1),SVGM$(9)
  8. Def Fn Z$(Z,LE)=Space$(LE-Len(Str$(Z)))+Str$(Z)
  9. Def Fn STL$(S$,LE)=S$+Space$(LE-Len(S$))
  10. Global FONT,TB,ICN(),TEX$,UP,SOU,MUS,PAG,WX,WY,B1,B2,S
  11. Degree 
  12. GRABICONS
  13. Restore MONATE
  14. For A=0 To 11
  15.   Read MON$(A)
  16. Next 
  17. Restore WETTER
  18. For A=0 To 6
  19.   Read WET$(A)
  20. Next 
  21. Restore PRODUKTE
  22. For A=0 To 4
  23.   Read PRO$(A),EH$(A)
  24. Next 
  25. Restore ANAUS
  26. Read AN$(0),AN$(1)
  27. Screen Open 0,320,200,32,0
  28. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  29. Get Sprite Palette 
  30. Colour Back Colour(0)
  31. Gr Writing 0
  32. Multi Wait : Limit Mouse 
  33. INITFONTS
  34. Set Font FONT
  35. Gosub UPFREE
  36. Amos To Front 
  37. WINDO[0,1,40,25,%111111,"Workbench"]
  38. PASICON[1,2,16,32,15,14,"Spiele"]
  39. DEFICON[0,0,8,7,15]
  40. IS=-1 : TIMOUT=25 : UP=0
  41. Do 
  42.   Multi Wait : BP=-1
  43.   Inc UP : If UP=200 Then Gosub UPFREE : UP=0
  44.   If PAG=0 Then Gosub WORKCLICKING : Gosub INRO
  45.   If PAG>0 Then CLICKING : B=Param : BP=B
  46.   If PAG=1 Then Gosub INITMENU
  47.   If PAG=2 Then Gosub MAINMENU
  48.   If PAG=3 Then Gosub ARBEITSMENU
  49.   If PAG=4 Then Gosub KARTMENU
  50.   If BP=0
  51.     ALERT["Free Trading Company","Wollen Sie wirklich","F.T.C. beenden?","Ja!","Nein!"]
  52.     If Param=1 : Gosub RETWORKBENCH : End If 
  53.   End If 
  54. Loop 
  55. Stop 
  56. AUTOTEST:
  57.   Inc UP : If UP=200 Then Gosub UPFREE : UP=0
  58.   If BP=0
  59.     ALERT["Free Trading Company","Wollen Sie wirklich","F.T.C. beenden?","Ja!","Nein!"]
  60.     If Param=1 : Pop : Gosub RETWORKBENCH : End If 
  61.   End If 
  62. Return 
  63. GOTCHA:
  64.   SSSS=Screen
  65.   Screen Open 4,320,32,2,0
  66.   Curs Off : Palette 0,$FFF
  67.   Print "Error"+Str$(Errn)+" trapped!"
  68.   Print "Please call me: 089/805847!"
  69.   Print "Press a key to continue...";
  70.   Wait Key 
  71.   Screen Close 4
  72.   If SSSS=>0 Then Screen SSSS
  73. Resume Next 
  74. UPFREE:
  75.   If PAG=4 Then Return 
  76.   Ink 2 : Bar 0,0 To 311,7
  77.   Put Cblock 25,312,0
  78.   T$="Amiga Workbench "+Str$(Chip Free)+" graphics mem "+Str$(Fast Free)+" other Mem"
  79.   Ink 0 : Text 1,5,T$
  80. Return 
  81. WORKCLICKING:
  82.   X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  83.   If M>1 Then Ink 2 : Bar 0,0 To 319,7 : UP=198
  84.   B=-1 : BB=-1
  85.   Inc TIMOUT
  86.   If M=0 Then MP=0
  87.   If MP=1 and M=1 Then M=0
  88.   If M=1 Then MP=1
  89.   If M=1 Then CHECKICONS[X,Y] : B=Param
  90.   If M=1 and B=-1 and IS>-1 Then PRESSICON[IS] : IS=-1
  91.   If B>-1
  92.     If IS>-1 : PRESSICON[IS] : End If 
  93.     If IS=B and TIMOUT<25
  94.       BB=B : TIMOUT=25
  95.     Else 
  96.       TIMOUT=0
  97.     End If 
  98.     IS=B
  99.     PRESSICON[B]
  100.   End If 
  101. Return 
  102. INRO:
  103.   If B=0
  104.     PRESSICON[B]
  105.     IS=-1 : TIMOUT=25
  106.     ALERT["Workbench Request","Do you really want","to quit workbench?","OK","Cancel"]
  107.     If Param=1 : Pop : Gosub QUIT : End If 
  108.   End If 
  109.   If BB=1 and ICN(2,0)=0
  110.     WINDO[10,5,30,20,%111111,"Spiele"]
  111.     Wait 20
  112.     DEFICON[3,80,40,87,47]
  113.     PASICON[2,1,160,100,64,48,"Free Trading Company"]
  114.   End If 
  115.   If B=3
  116.     PRESSICON[B]
  117.     IS=-1 : TIMOUT=25
  118.     UNDEFICON[2]
  119.     UNDEFICON[3]
  120.     WINCLO[10,5,30,20]
  121.   End If 
  122.   If BB=2
  123.     IS=-1
  124.     UNDEFICON[1]
  125.     UNDEFICON[2]
  126.     Wait 10
  127.     WINDO[0,5,40,15,%1110,"IconX"]
  128.     Wait 5
  129.     Ink 2 : Text 4,47+TB,"Lade Free Trading Company... Bitte warten!"
  130.     If Length(5)=0
  131.       Load "KartSounds.dat",6
  132.       Load "WorkSounds.dat",5
  133.       Sam Bank 5
  134.       Open In 1,"mod.InGame"
  135.         Reserve As Chip Work 3,Lof(1)
  136.         Sload 1 To Start(3),Lof(1)
  137.       Close 1
  138.     End If 
  139.     TITLE
  140.     Loke Start(12)+10,Start(3)
  141.     Call Start(12)
  142.     Call Start(12)+6
  143.     WINDO[0,1,40,25,%11,"Free Trading Company Version 1.22"]
  144.     PAG=1
  145.     Ink 1 : CT[18,"Willkommen zu"]
  146.     Ink 3 : CT[28,"Free Trading Company"]
  147.     Ink 2 : Text 4,70+TB,"Wieviele Spieler:"
  148.     DEFGADGET[2,80,58,112,90,"1"]
  149.     DEFGADGET[3,114,58,146,90,"2"]
  150.     DEFGADGET[4,148,58,180,90,"3"]
  151.     DEFGADGET[5,182,58,214,90,"4"]
  152.     PASICON[1,9,40,176,32,24,"Spielstand laden"]
  153.   End If 
  154.   B=-1 : BB=-1
  155. Return 
  156. INITMENU:
  157.   If B>1 and B<6
  158.     Gosub GAMEINIT
  159.   End If 
  160.   If B=1
  161.     For A=0 To 5
  162.       DISABLEICON[A]
  163.     Next 
  164.     Gosub SPIELLOAD
  165.     For A=0 To 5
  166.       ENABLEICON[A]
  167.     Next 
  168.     If LOA
  169.       WINCLR[0,1,40,25]
  170.       UNDEFICON[1]
  171.       UNDEFICON[2]
  172.       UNDEFICON[3]
  173.       UNDEFICON[4]
  174.       UNDEFICON[5]
  175.       PAG=2 : Gosub UPDATSCREEN1
  176.     End If 
  177.   End If 
  178.   B=-1 : BB=-1
  179. Return 
  180. MAINMENU:
  181.   If B=1
  182.     For A=1 To 20
  183.       DISABLEICON[A]
  184.     Next 
  185.     MO=1
  186.     Get Cblock 998,24,40,144,72
  187.     WINDO[3,5,21,14,%110,"Ankauf von Waren"]
  188.     For A=0 To 4
  189.       DEFGADGET[10+A,28,50+A*10,72,58+A*10,PRO$(A)]
  190.     Next 
  191.     DEFGADGET[15,28,100,162,108,"Zur�ck"]
  192.   End If 
  193.   If B=2
  194.     For A=1 To 20
  195.       DISABLEICON[A]
  196.     Next 
  197.     MO=2
  198.     Get Cblock 998,24,40,144,64
  199.     WINDO[3,5,21,13,%110,"Verkauf von Waren"]
  200.     For A=1 To 4
  201.       DEFGADGET[10+A,28,40+A*10,72,48+A*10,PRO$(A)]
  202.     Next 
  203.     DEFGADGET[15,28,90,162,98,"Zur�ck"]
  204.   End If 
  205.   If B=3
  206.     Fade 2
  207.     For A=0 To 31
  208.       Colour Back Colour(0) : View : Wait Vbl 
  209.     Next 
  210.     WINCLO[1,3,20,16]
  211.     WINCLO[20,17,39,24]
  212.     WINCLO[1,17,19,24]
  213.     For A=1 To 20
  214.       UNDEFICON[A]
  215.     Next 
  216.     PAG=4 : Gosub KARTE
  217.   End If 
  218.   If B>9 and B<15 Then Gosub KAUF
  219.   If B=9
  220.     For A=1 To 20
  221.       DISABLEICON[A]
  222.     Next 
  223.     Get Cblock 998,16,40,160,88
  224.     WINDO[2,5,22,16,%110,"Optionen"]
  225.     PASICON[20,9,56,63,32,24,"Spielstand laden"]
  226.     PASICON[21,10,56,95,32,24,"Spielstand sichern"]
  227.     PASICON[22,11+MUS,136,63,32,24,"Musik "+AN$(1-MUS)+"schalten"]
  228.     PASICON[23,13+SOU,136,95,32,24,"Sound "+AN$(1-SOU)+"schalten"]
  229.     DEFGADGET[15,20,116,170,124,"Zur�ck"]
  230.   End If 
  231.   If B=21 Then Gosub SPIELSAVE
  232.   If B=20 Then Gosub SPIELLOAD : If LOA Then B=-15
  233.   If Abs(B)=15
  234.     Put Cblock 998
  235.     Del Cblock 998
  236.     For A=10 To 25
  237.       UNDEFICON[A]
  238.     Next 
  239.     For A=1 To 20
  240.       ENABLEICON[A]
  241.     Next 
  242.     MO=0
  243.   End If 
  244.   If B=-15 Then Gosub UPDATSCREEN1
  245.   If B=22
  246.     ERAICON[B]
  247.     MUS=1-MUS
  248.     PASICON[B,11+MUS,136,63,32,24,"Musik "+AN$(1-MUS)+"schalten"]
  249.     If MUS=0
  250.       Call Start(12)+8
  251.       Call Start(12)+4
  252.     Else 
  253.       Call Start(12)+6
  254.     End If 
  255.   End If 
  256.   If B=23
  257.     ERAICON[B]
  258.     SOU=1-SOU
  259.     PASICON[B,13+SOU,136,95,32,24,"Sound "+AN$(1-SOU)+"schalten"]
  260.   End If 
  261.   B=-1 : BB=-1
  262. Return 
  263. ARBEITSMENU:
  264.   If B>0 and B<5
  265.     Get Cblock 998,24,64,144,40
  266.     If B<3 : A$="Arbeiter" : P=0 : Else A$="Facharbeiter" : P=1 : End If 
  267.     If B and 1 : B$="einstellen" : Else B$="entlassen" : End If 
  268.     WINDO[3,8,21,13,%110,A$+" "+B$]
  269.     Ink 2
  270.     If PL(CP,30)
  271.       If(P=0 and PL(CP,30)<0) or(P=1 and PL(CP,30)>0)
  272.         If SOU : Sam Bank 6 : Sam Play 8,9 : Sam Bank 5 : End If 
  273.         Text 28,71+TB,"Die "+A$+" streiken doch!"
  274.         Wait 50
  275.         Put Cblock 998
  276.         Del Cblock 998
  277.         B=-1 : BB=-1 : Return 
  278.       End If 
  279.     End If 
  280.     If(B and 1)=0 and PL(CP,8+P)=0
  281.       If SOU : Sam Play 8,2 : End If 
  282.       Text 28,71+TB,"Sie haben keine "+A$+"!"
  283.       Wait 50
  284.     Else 
  285.       Text 28,71+TB,"Wieviele "+A$+" wollen Sie"
  286.       Text 28,77+TB,B$+"?"
  287.       If(B and 1)=0
  288.         Ink 1 : Text 28,83+TB,"(Das kostet Sie"+Str$(PL(CP,10+P)*4)+" $ pro Person!)"
  289.         Ink 2
  290.         TEX$=Str$(Max(PL(CP,8+P)-PL(CP,13+P),0))-" "
  291.       Else 
  292.         Ink 1 : Text 28,83+TB,"(Das kostet Sie"+Str$(PL(CP,10+P))+" $ pro Person!)"
  293.         Ink 2
  294.         TEX$=Str$(Max(PL(CP,13+P)-PL(CP,8+P),0))-" "
  295.       End If 
  296.       If TEX$="0" : TEX$="" : End If 
  297.       EINGABE[28,89,6,5,1]
  298.       A=0
  299.       If TEX$<>""
  300.         For DD=1 To Len(TEX$)
  301.           A=A*10+Asc(Mid$(TEX$,DD,1))-48
  302.         Next 
  303.       End If 
  304.       If B and 1
  305.         A=Min(99999-PL(CP,8+P),A)
  306.         Add PL(CP,8+P),A
  307.         Add PL(CP,0),-PL(CP,10+P)*A
  308.         PL(CP,0)=Max(PL(CP,0),-9000000)
  309.       Else 
  310.         If SOU : Sam Play 8,3 : End If 
  311.         A=Min(A,PL(CP,8+P))
  312.         Add PL(CP,0),-PL(CP,10+P)*4*A
  313.         PL(CP,0)=Max(PL(CP,0),-9000000)
  314.         Add PL(CP,8+P),-A
  315.       End If 
  316.     End If 
  317.     Put Cblock 998
  318.     Del Cblock 998
  319.     Gosub UPDATARBEITER
  320.     Gosub UPDATLOHNKOSTEN
  321.   End If 
  322.   If B=5
  323.     WINCLO[1,3,20,16]
  324.     WINCLO[1,17,22,24]
  325.     WINCLO[23,17,39,24]
  326.     For A=1 To 20
  327.       UNDEFICON[A]
  328.     Next 
  329.     PAG=5 : Gosub UPDATSCREEN3
  330.     Gosub BEWASSERUNG
  331.   End If 
  332.   B=-1 : BB=-1
  333. Return 
  334. KARTE:
  335.   DISABLEICON[0]
  336.   Sam Bank 6
  337.   Unpack 13 To 1 : Screen To Back 
  338.   Curs Off : Flash Off : Paper 0 : Pen 1
  339.   Colour 16,0
  340.   KART=-1 : Gr Writing 0
  341.   Ink 31,0
  342.   A$="Aktions Menu"
  343.   OT[160-Len(A$)*4,8,4,20,A$]
  344.   For A=0 To 8
  345.     X1=39 : Y1=17+Min(A,7)*20 : X2=56 : Y2=34+Min(A,7)*20
  346.     If A=8 Then Add X1,128 : Add X2,128
  347.     Ink 26 : Draw X1-1,Y2+1 To X1-1,Y1-1 : Draw To X2+1,Y1-1
  348.     Ink 31 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  349.     Ink 20 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  350.     Ink 23 : Draw X1,Y2+1 To X2+1,Y2+1 : Draw To X2+1,Y1
  351.     DEFICON[A+1,X1-1,Y1-1,X2,Y2]
  352.   Next 
  353.   Paste Bob 40,18,39
  354.   Paste Bob 40,38,42
  355.   Paste Bob 40,58,44
  356.   Paste Bob 40,78,43
  357.   Paste Bob 40,98,41
  358.   Paste Bob 40,118,38
  359.   Paste Bob 40,138,40
  360.   Paste Bob 40,158,47
  361.   Paste Bob 168,158,45
  362.   PM=PL(CP,15)*500
  363.   OT[64,28,31,20,"Roden                  "+ Fn Z$(PM+1500,6)+" $"]
  364.   OT[64,48,31,20,"Dattelplantage pflanzen"+ Fn Z$(PM+3000,6)+" $"]
  365.   OT[64,68,31,20,"Tabak anbauen          "+ Fn Z$(PM+4000,6)+" $"]
  366.   OT[64,88,31,20,"Zigarettenfabrik bauen "+ Fn Z$(PM+20000,6)+" $"]
  367.   OT[64,108,31,20,"�lturm errichten       "+ Fn Z$(PM+30000,6)+" $"]
  368.   OT[64,128,31,20,"Insektizide verspr�hen "+ Fn Z$(PM+10000,6)+" $"]
  369.   OT[64,148,31,20,"Mitspieler angreifen   "+ Fn Z$(PM+40000,6)+" $"]
  370.   OT[64,168,31,20,"Karte"]
  371.   OT[192,168,31,20,"Weiter"]
  372.   Get Cblock 998,64,178,240,16
  373.   Paste Bob 40,178,46
  374.   OT[64,188,31,20,"Geld"+ Fn Z$(PL(CP,0),25)+" $"]
  375.   Screen Open 3,320,200,32,0 : Screen To Back 
  376.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  377.   Get Palette 1
  378.   Screen To Front 
  379.   WX=Screen Width : WY=Screen Height : B1=1 : B2=3
  380.   A=Rnd(13)+1 : S=8
  381.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  382.   Screen To Front 1
  383.   Screen Close 3
  384.   Screen 1
  385.   PAG=4
  386. Return 
  387. KARTMENU:
  388.   If B>0 and B<9
  389.     If B=1 : P=1500+PM : End If 
  390.     If B=2 : P=3000+PM : End If 
  391.     If B=3 : P=4000+PM : End If 
  392.     If B=4 : P=20000+PM : End If 
  393.     If B=5 : P=30000+PM : End If 
  394.     If B=6 : P=10000+PM : End If 
  395.     If B=7 : P=40000+PM : End If 
  396.     If B=8 : P=-99999999 : End If 
  397.     If PL(CP,0)<P
  398.       Gosub NOMONEY
  399.     Else 
  400.       If B<>7
  401.         MO=B : Gosub EDIKARTE
  402.       Else 
  403.         If PL>1
  404.           Gosub ANGRIFF
  405.         Else 
  406.           If SOU : Sam Play 8,2 : End If 
  407.         End If 
  408.       End If 
  409.     End If 
  410.   End If 
  411.   If B=9
  412.     If KART>-1 : Screen Close 2 : End If 
  413.     Screen Open 3,320,200,32,0 : Screen To Back 
  414.     Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  415.     Get Palette 1
  416.     Screen To Front 1
  417.     WX=Screen Width : WY=Screen Height : B1=3 : B2=1
  418.     A=Rnd(13)+1 : S=8
  419.     On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  420.     Screen Close 3
  421.     Screen Close 1
  422.     Screen 0
  423.     ENABLEICON[0]
  424.     For A=1 To 20
  425.       UNDEFICON[A]
  426.     Next 
  427.     Gosub COMPUTE3
  428.     PAG=3 : Gosub UPDATSCREEN2
  429.   End If 
  430.   B=-1 : BB=-1
  431. Return 
  432. NOMONEY:
  433.   If SOU : Sam Play 8,2 : End If 
  434.   For A=0 To 7
  435.     OT[64,188,Abs((A and 1)*31),20,"Geld"+ Fn Z$(PL(CP,0),25)+" $"]
  436.     Wait 5
  437.   Next 
  438. Return 
  439. EDIKARTE:
  440.   Gosub INITKARTE
  441.   Screen Open 3,320,10,32,0 : Screen Hide 
  442.   Flash Off : Curs Off : Paper 0 : Pen 31
  443.   Cls : Gr Writing 0
  444.   OT[1,7,31,20, Fn Z$(PL(CP,0),11)+" $"]
  445.   Get Bob 48,0,0 To 112,10
  446.   OLMN=PL(CP,0) : OLPO=1
  447.   Screen 2
  448.   Hide On 
  449.   Repeat 
  450.     X=X Screen(X Mouse)/8 : Y=Y Screen(Y Mouse)/8 : M=Mouse Key
  451.     If OLMN<>PL(CP,0)
  452.       Bob Off 20
  453.       Screen 3
  454.       Cls 
  455.       OT[1,7,31,20, Fn Z$(PL(CP,0),11)+" $"]
  456.       Get Bob 48,0,0 To 112,10
  457.       OLMN=PL(CP,0)
  458.       Screen 2
  459.       OLPO=1
  460.     End If 
  461.     If OLPO=1 or((Y*8)>99)=OLPO
  462.       Wait Vbl : Bob 20,208,-((Y*8)<100)*190,48
  463.       OLPO=(Y*8)<100
  464.     End If 
  465.     Sprite 0,X Hard(X*8)+2,Y Hard(Y*8)+2,2
  466.     If M=1
  467.       F=F(CP,X,Y)
  468.       If MO=1
  469.         Gosub CINS
  470.         If DD=16 and((F>9 and F<42) or(F>65))
  471.           If SOU : Sam Play 8,4 : End If 
  472.           GX=X : GY=Y : F=Rnd(1) : Gosub PASBLOCK
  473.           Add PL(CP,0),-P
  474.         Else 
  475.           If SOU : Sam Play 8,2 : End If 
  476.         End If 
  477.       End If 
  478.       If MO=2
  479.         If F<2
  480.           If SOU : Sam Play 8,8 : End If 
  481.           F(CP,X,Y)=67 : Inc PL(CP,17)
  482.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  483.           Add PL(CP,0),-P
  484.         Else 
  485.           If SOU : Sam Play 8,2 : End If 
  486.         End If 
  487.       End If 
  488.       If MO=3
  489.         If F<2
  490.           If SOU : Sam Play 8,8 : End If 
  491.           F(CP,X,Y)=69 : Inc PL(CP,18)
  492.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  493.           Add PL(CP,0),-P
  494.         Else 
  495.           If SOU : Sam Play 8,2 : End If 
  496.         End If 
  497.       End If 
  498.       If MO=4
  499.         If F<2
  500.           If SOU : Sam Play 8,5 : End If 
  501.           F(CP,X,Y)=68 : Inc PL(CP,19)
  502.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  503.           Add PL(CP,0),-P
  504.         Else 
  505.           If SOU : Sam Play 8,2 : End If 
  506.         End If 
  507.       End If 
  508.       If MO=5
  509.         If F<2
  510.           If SOU
  511.             For A=0 To 29
  512.               Sam Play 8,6,6000+Sin(A*10+90)*1000
  513.               Wait 5
  514.             Next 
  515.           End If 
  516.           If Rnd(2)=1
  517.             If SOU : Sam Play 8,7 : End If 
  518.             F(CP,X,Y)=70 : Inc PL(CP,16)
  519.             Put Cblock F(CP,X,Y)+50,X*8,Y*8
  520.             Add PL(CP,0),-P
  521.           Else 
  522.             If SOU : Sam Play 8,9 : End If 
  523.             Add PL(CP,0),-P
  524.           End If 
  525.         Else 
  526.           If SOU : Sam Play 8,2 : End If 
  527.         End If 
  528.       End If 
  529.       If MO=6
  530.         Gosub CINS
  531.         If DD<16
  532.           If SOU : Sam Play 8,6 : End If 
  533.           IN(CP,DD,0)=-1 : IN(CP,DD,1)=-1 : IN(CP,DD,2)=0
  534.           Add PL(CP,0),-P
  535.           Bob Off DD
  536.         Else 
  537.           If SOU : Sam Play 8,2 : End If 
  538.         End If 
  539.       End If 
  540.       While Mouse Key : Multi Wait : Wend 
  541.     End If 
  542.     If MO=8 and M=1 Then M=2
  543.     Multi Wait 
  544.   Until PL(CP,0)<P or M>1
  545.   Show On 
  546.   Bob Off 20
  547.   Screen Close 3
  548.   Gosub QUITKARTE
  549. Return 
  550. CINS:
  551.   For DD=0 To 15
  552.     If IN(CP,DD,0)=X and IN(CP,DD,1)=Y : Exit : End If 
  553.   Next 
  554. Return 
  555. ANGRIFF:
  556.   OP=CP
  557.   For A=1 To 20
  558.     DISABLEICON[A]
  559.   Next 
  560.   Get Cblock 997,40,50,240,100
  561.   Ink 26 : Bar 40,50 To 279,149
  562.   Ink 31 : Draw 40,149 To 40,50 : Draw To 279,50
  563.   Ink 20 : Draw 41,149 To 279,149 : Draw To 279,51
  564.   OT[104,60,31,20,"Wen angreifen?"]
  565.   Y=0
  566.   For A=0 To PL-1
  567.     If OP<>A Then DEFGADGET2[10+A,48,72+Y*16,271,84+Y*16,PL$(A,1)] : Inc Y
  568.   Next 
  569.   DEFGADGET2[14,48,72+Y*16,271,84+Y*16,"Abbruch"]
  570.   CP=-1
  571.   Repeat 
  572.     Multi Wait 
  573.     CLICKING : B=Param
  574.     If B>0 Then CP=B-10
  575.   Until CP>-1
  576.   Put Cblock 997
  577.   Del Cblock 997
  578.   For A=10 To 14
  579.     UNDEFICON[A]
  580.   Next 
  581.   For A=1 To 20
  582.     ENABLEICON[A]
  583.   Next 
  584.   If CP=4 Then CP=OP : Return 
  585.   Hide On 
  586.   Add PL(OP,0),-P
  587.   If MUS Then Call Start(12)+8 : Call Start(12)+4
  588.   If SOU
  589.     For A=0 To 2
  590.       Sam Play 8,10
  591.       Wait 60
  592.     Next 
  593.   End If 
  594.   Gosub INITKARTE
  595.   For A=0 To 4
  596.     X=320 : Y=Rnd(22)+1
  597.     TX=Rnd(35)+2 : H=12
  598.     If SOU Then Sam Play 8,11
  599.     Repeat 
  600.       If Mouse Key=0 Then Wait Vbl 
  601.       Sprite 2,X Hard(X),Y Hard(Y*8-H+4),50+(X and 1)
  602.       Dec X : BX=X/8
  603.       If BX<TX+2 Then Dec H
  604.     Until H=0
  605.     If SOU Then Sam Play 8,3
  606.     For C=0 To 27
  607.       Sprite 2,X Hard(X-4),Y Hard(Y*8-8),C+10
  608.       Wait 3
  609.     Next 
  610.     F=66
  611.     GX=TX : GY=Y : Gosub PASBLOCK
  612.     GX=TX+1 : GY=Y : Gosub PASBLOCK
  613.     GX=TX : GY=Y-1 : Gosub PASBLOCK
  614.     GX=TX+1 : GY=Y-1 : Gosub PASBLOCK
  615.     For C=15 To 0 Step -1
  616.       Colour 31,$FF0+C : Wait 2
  617.     Next 
  618.     Sprite Off : Multi Wait 
  619.     Colour 31,$FFF
  620.   Next 
  621.   CP=OP
  622.   Gosub QUITKARTE
  623.   If MUS Then Call Start(12)+6
  624.   Show On 
  625. Return 
  626. INITKARTE:
  627.   If KART<>CP
  628.     Screen Open 2,320,200,32,0 : Screen To Back 
  629.     Curs Off : Flash Off : Cls 0
  630.     Get Palette 1
  631.     For Y=0 To 24
  632.       For X=0 To 39
  633.         Put Cblock F(CP,X,Y)+50,X*8,Y*8
  634.       Next 
  635.     Next 
  636.     For A=0 To 15
  637.       If IN(CP,A,0)>-1 : Bob A,IN(CP,A,0)*8,IN(CP,A,1)*8,56 : End If 
  638.     Next 
  639.   Else 
  640.     Screen 2
  641.   End If 
  642.   Screen Open 3,320,200,32,0 : Screen To Back 
  643.   Curs Off : Flash Off : Paper 0 : Pen 1
  644.   Get Palette 2
  645.   Screen Copy 1 To 3
  646.   Screen To Front 
  647.   WX=Screen Width : WY=Screen Height : B1=2 : B2=3
  648.   A=Rnd(13)+1 : S=8
  649.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  650.   Screen To Front 2
  651.   Screen Close 3
  652.   Screen 2
  653.   KART=CP
  654. Return 
  655. PASBLOCK:
  656.   GF=F(CP,GX,GY)
  657.   For DD=0 To 15
  658.     If IN(CP,DD,0)=X and IN(CP,DD,1)=Y Then IN(CP,DD,0)=-1 : IN(CP,DD,1)=-1 : IN(CP,DD,2)=0 : Bob Off DD
  659.   Next 
  660.   If GF=67 Then Dec PL(CP,17)
  661.   If GF=68 Then Dec PL(CP,19)
  662.   If GF=69 Then Dec PL(CP,18)
  663.   If GF=70 Then Dec PL(CP,16)
  664.   F(CP,GX,GY)=F
  665.   Put Cblock F+50,GX*8,GY*8
  666.   If F=67 Then Inc PL(CP,17)
  667.   If F=68 Then Inc PL(CP,19)
  668.   If F=69 Then Inc PL(CP,18)
  669.   If F=70 Then Inc PL(CP,16)
  670. Return 
  671. QUITKARTE:
  672.   Screen 1 : Put Cblock 998 : OT[64,188,31,20,"Geld"+ Fn Z$(PL(CP,0),25)+" $"]
  673. QUITKARTE2:
  674.   Screen Open 3,320,200,32,0 : Screen To Back 
  675.   Curs Off : Flash Off : Paper 0 : Pen 1
  676.   Get Palette 2
  677.   Screen Copy 2 To 3
  678.   Screen To Front 
  679.   WX=Screen Width : WY=Screen Height : B1=1 : B2=3
  680.   A=Rnd(13)+1 : S=8
  681.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  682.   Screen To Front 1
  683.   Screen Close 3
  684.   Screen 1
  685. Return 
  686. UPDATSCREEN3:
  687.   Sam Bank 5
  688.   WINDO[1,3,20,16,%10,"Feldbew�sserung "+PL$(CP,1)]
  689.   Ink 1 : Text 12,31+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  690.   Ink 2
  691.   Text 12,40+TB,Str$(PL(CP,1))-" "+EH$(0)+" "+PRO$(0)+" sind im Turm."
  692.   Gosub BENWASSER
  693.   Text 12,47+TB,A$
  694.   Text 12,53+TB,B$
  695.   Text 12,59+TB,C$
  696.   Text 12,66+TB,"Mit wieviel"+EH$(0)+" "+PRO$(0)+" wollen"
  697.   Text 12,72+TB,"Sie bew�ssern?"
  698.   Gosub ZEIGWASSERTURM
  699. Return 
  700. BEWASSERUNG:
  701.   TEX$=Str$(Min(PL(CP,12),PL(CP,1)))-" "
  702.   EINGABE[12,78,7,6,1]
  703.   A=Min(Val(TEX$),PL(CP,1))
  704.   PL(CP,29)=A
  705.   Add PL(CP,1),-A
  706.   Gosub WASSERSTAND
  707.   WINCLO[1,3,20,16]
  708.   WINCLO[21,3,39,16]
  709.   Gosub COMPUTE1
  710.   Gosub COMPUTE2
  711.   PAG=2 : Gosub UPDATSCREEN1
  712. Return 
  713. UPDATSCREEN2:
  714.   Sam Bank 5
  715.   WINDO[1,3,20,16,%10,"Arbeitsmarkt "+PL$(CP,1)]
  716.   Ink 1 : Text 12,31+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  717.   Gosub UPDATARBEITER
  718.   PASICON[1,7,38,76,32,24,"Arbeiter ein."]
  719.   PASICON[2,6,96,76,32,24,"Arbeiter ent."]
  720.   PASICON[3,7,38,107,32,24,"Facharb. ein."]
  721.   PASICON[4,6,96,107,32,24,"Facharb. ent."]
  722.   PASICON[5,5,136,107,32,24,"Weiter"]
  723.   WINDO[1,17,22,24,%10,"Informationen"]
  724.   Ink 1
  725.   Text 12,143+TB,"Immobilie           Ben�tigte Arbeiter"
  726.   Ink 2
  727.   Text 12,151+TB,"�lfelder         30 Arbeiter 25 Facharb."
  728.   Text 12,157+TB,"Dattelplantage   20 Arbeiter  0 Facharb."
  729.   Text 12,163+TB,"Tabakplantage    30 Arbeiter  0 Facharb."
  730.   Text 12,169+TB,"Zigarettenfabrik 40 Arbeiter 10 Facharb."
  731.   Draw 12,151 To 172,151
  732.   Draw 125,151 To 125,175
  733.   Ink 1
  734.   Text 12,176+TB,"Ben�tigte Arbeiter    "+ Fn Z$(PL(CP,13),7)
  735.   Text 12,182+TB,"Ben�tigte Facharbeiter"+ Fn Z$(PL(CP,14),7)
  736.   Gosub UPDATLOHNKOSTEN
  737.   Fade 2 To -1
  738.   For A=0 To 31
  739.     Colour Back Colour(0) : View : Wait Vbl 
  740.   Next 
  741.   If(Rnd(20)=0) or(PL(CP,30)<>0) Then Gosub LOHNERHOHUNG
  742. Return 
  743. LOHNERHOHUNG:
  744.   Ink 2
  745.   If PL(CP,30)
  746.     G=Abs(PL(CP,30))+1
  747.     If PL(CP,30)<0 : P=0 : Else P=1 : End If 
  748.   Else 
  749.     G=Rnd(4)+1 : P=Rnd(1)
  750.     If PL(CP,P+8)=0 : Return : End If 
  751.   End If 
  752.   If P=0
  753.     PL(CP,30)=-G : A$="Arbeiter"
  754.   Else 
  755.     PL(CP,30)=G : A$="Facharbeiter"
  756.   End If 
  757.   Get Cblock 998,24,40,144,64
  758.   WINDO[3,5,21,13,%110,"Lohnerh�hung"]
  759.   For A=0 To 20
  760.     DISABLEICON[A]
  761.   Next 
  762.   Text 28,47+TB,"Die "+A$+" fordern eine"
  763.   Text 28,53+TB,"Gehaltserh�hung um"+Str$(G)+"$."
  764.   Text 28,60+TB,"Sind Sie einverstanden?"
  765.   DEFGADGET[6,28,68,94,76,"Ja"]
  766.   DEFGADGET[7,96,68,163,76,"Nein!"]
  767.   Repeat 
  768.     Multi Wait 
  769.     CLICKING : B=Param
  770.   Until B>-1
  771.   If B=6
  772.     Add PL(CP,10+P),G
  773.     PL(CP,30)=0
  774.     Text 28,78+TB,"Die "+A$+" freuen sich sehr"
  775.     Text 28,84+TB,"�ber Ihre Entscheidung!"
  776.     If SOU : Sam Play 8,3 : End If 
  777.   Else 
  778.     If Rnd(20)<6
  779.       Text 28,78+TB,"Die "+A$+" sind sehr, sehr"
  780.       Text 28,84+TB,"entt�uscht!"
  781.       PL(CP,30)=0
  782.       If SOU : Sam Play 8,2 : End If 
  783.     Else 
  784.       G=(PL(CP,8+P)*(Rnd(50)+25))/100
  785.       Add PL(CP,8+P),-G
  786.       Text 28,78+TB,"Die "+A$+" sind sehr w�tend!"
  787.       Text 28,84+TB,Str$(G)-" "+" "+A$+" k�ndigen,"
  788.       Text 28,90+TB,"und die anderen streiken!"
  789.       If SOU : Sam Bank 6 : Sam Play 8,9 : Sam Bank 5 : End If 
  790.     End If 
  791.   End If 
  792.   Wait 200
  793.   UNDEFICON[6]
  794.   UNDEFICON[7]
  795.   For A=0 To 20
  796.     ENABLEICON[A]
  797.   Next 
  798.   Put Cblock 998
  799.   Del Cblock 998
  800.   Gosub UPDATARBEITER
  801.   Gosub UPDATLOHNKOSTEN
  802. Return 
  803. UPDATARBEITER:
  804.   Ink 0 : Bar 12,38 To 156,63
  805.   Ink 2
  806.   Text 12,38+TB,"Geld"+ Fn Z$(PL(CP,0),10)+" $"
  807.   Text 12,44+TB,"�lfelder "+ Fn Z$(PL(CP,16),5)+" Tabakplantagen  "+ Fn Z$(PL(CP,18),5)
  808.   Text 12,50+TB,"Datteln  "+ Fn Z$(PL(CP,17),5)+" Zigarettenfab.  "+ Fn Z$(PL(CP,19),5)
  809.   Text 12,56+TB,"Arbeiter"+ Fn Z$(PL(CP,8),6)+" Facharbeiter   "+ Fn Z$(PL(CP,9),6)
  810. Return 
  811. UPDATLOHNKOSTEN:
  812.   WINDO[23,17,39,24,%10,"Lohnkosten und -preise"]
  813.   Ink 2
  814.   Text 188,143+TB,"Arbeiter    "+ Fn Z$(PL(CP,10),5)+" $"
  815.   Text 188,150+TB,"Facharbeiter"+ Fn Z$(PL(CP,11),5)+" $"
  816.   Ink 1 : Text 204,157+TB,"Lohnkosten pro Monat:"
  817.   Ink 2
  818.   P1=PL(CP,8)*PL(CP,10)
  819.   P2=PL(CP,9)*PL(CP,11)
  820.   Text 188,164+TB,"Arbeiter"+ Fn Z$(PL(CP,8),6)+"*"+ Fn Z$(PL(CP,10),3)+"$="+ Fn Z$(P1,8)+" $"
  821.   Text 188,171+TB,"Facharb."+ Fn Z$(PL(CP,9),6)+"*"+ Fn Z$(PL(CP,11),3)+"$="+ Fn Z$(P2,8)+" $"
  822.   Ink 1 : Text 188,178+TB,"Zusammen"+ Fn Z$(P1+P2,20)+" $"
  823.   Draw 275,186 To 306,186
  824.   Draw 275,188 To 306,188
  825. Return 
  826. KAUF:
  827.   D=B-10
  828.   Ink 2
  829.   If MO=1
  830.     P=(PL(CP,20+D)*6)/5
  831.     If P<=PL(CP,0)
  832.       If D=0
  833.         Gosub ZEIGWASSERTURM : Ink 2
  834.       End If 
  835.       If D=1
  836.         Gosub ZEIGOL : Ink 2
  837.       End If 
  838.       Text 78,50+TB,"Wieviel"+EH$(D)+" "+PRO$(D)
  839.       Text 78,56+TB,"wollen Sie kaufen?"
  840.       MX=Min(PL(CP,0)/P,PL(0,31+D))
  841.       If D=0 : MX=Min(MX,100000-PL(CP,1)) : End If 
  842.       Text 78,62+TB,"(max."+Str$(MX)+")"
  843.       TEX$="" : EINGABE[78,68,7,6,1]
  844.       A=Val(TEX$)
  845.       If D=0 and A>MX : A=MX : End If 
  846.       If A*P<=PL(CP,0)
  847.         If A<=MX
  848.           If SOU : Sam Play 8,3 : End If 
  849.           Add PL(CP,0),-A*P
  850.           Add PL(CP,D+1),A
  851.           Add PL(0,D+31),-A
  852.           If D>0
  853.             G=PL(0,24+D)
  854.             If G<90 or G>270 : G=(540-G) mod 360 : End If 
  855.             G=Min(G-Min(A/10,90),90)
  856.             PL(0,24+D)=G
  857.           End If 
  858.           Gosub UPDATBESITZ
  859.         Else 
  860.           If SOU : Sam Play 8,2 : End If 
  861.           Text 78,74+TB,"Soviele Waren sind"
  862.           Text 78,80+TB,"nicht auf dem Markt!"
  863.           Wait 50
  864.         End If 
  865.       Else 
  866.         If SOU : Sam Play 8,2 : End If 
  867.         Text 78,74+TB,"Soviel Geld haben"
  868.         Text 78,80+TB,"Sie nicht!"
  869.         Wait 50
  870.       End If 
  871.       If D=0
  872.         Gosub WASSERSTAND
  873.       End If 
  874.       Gosub ZEIGPLANTAGE
  875.     Else 
  876.       If SOU : Sam Play 8,2 : End If 
  877.       Text 78,50+TB,"Das k�nnen Sie sich"
  878.       Text 78,56+TB,"nicht leisten!"
  879.       Wait 50
  880.     End If 
  881.   Else 
  882.     P=PL(CP,20+D)
  883.     If PL(CP,D+1)>0
  884.       If D=1
  885.         Gosub ZEIGOL : Ink 2
  886.       End If 
  887.       Text 78,50+TB,"Wieviel"+EH$(D)+" "+PRO$(D)
  888.       Text 78,56+TB,"wollen Sie verkaufen?"
  889.       If P>0 : Text 78,62+TB,"(max."+Str$(PL(CP,D+1))+")" : End If 
  890.       TEX$="" : EINGABE[78,68,7,6,1]
  891.       A=Min(Val(TEX$),PL(CP,D+1))
  892.       If SOU : Sam Play 8,3 : End If 
  893.       Add PL(CP,0),A*P
  894.       Add PL(CP,D+1),-A
  895.       Add PL(0,D+31),A
  896.       If D>0
  897.         G=PL(0,24+D)
  898.         If G>90 and G<270 : G=(540-G) mod 360 : End If 
  899.         G=Min((G-Min(A/40,90)+360) mod 360,270)
  900.         PL(0,24+D)=G
  901.       End If 
  902.       Gosub ZEIGPLANTAGE
  903.       Gosub UPDATBESITZ
  904.     Else 
  905.       If SOU : Sam Play 8,2 : End If 
  906.       Text 78,50+TB,"Davon haben Sie"
  907.       Text 78,56+TB,"doch nichts!"
  908.       Wait 50
  909.     End If 
  910.   End If 
  911.   Ink 0 : Bar 78,50 To 160,86
  912. Return 
  913. ZEIGWASSERTURM:
  914.   WINDO[21,3,39,16,%10,"Der Wasserturm"]
  915.   Paste Bob 171,33,4
  916.   OWA=85-((PL(CP,1)*37)/100000)
  917.   If OWA=85 Then Return 
  918.   For Y=85 To OWA Step -1
  919.     X1=220 : X2=258
  920.     For X=0 To 5
  921.       If Point(X+220,Y)<>2 Then Inc X1
  922.       If Point(258-X,Y)<>2 Then Dec X2
  923.     Next 
  924.     Ink 3 : Draw X1,Y To X2,Y
  925.   Next 
  926. Return 
  927. WASSERSTAND:
  928.   NWA=85-((PL(CP,1)*37)/100000)
  929.   If NWA=OWA Then Return 
  930.   If SOU Then Sam Loop On : Sam Play 8,4
  931.   For Y=OWA To NWA Step Sgn(NWA-OWA)
  932.     X1=220 : X2=258
  933.     For X=0 To 5
  934.       If Point(X+220,Y)/2<>1 Then Inc X1
  935.       If Point(258-X,Y)/2<>1 Then Dec X2
  936.     Next 
  937.     If NWA>OWA
  938.       Ink 2
  939.       Draw X1,Y To X2,Y
  940.     Else 
  941.       Ink 3
  942.       Draw 253,46 To 254,46
  943.       If Y>47
  944.         Bar 253,47 To Min(257,X2),Y
  945.         Draw X1,Y To X2,Y
  946.       Else 
  947.         Draw 253,47 To 258,47
  948.         Draw X1,Y To X2,Y
  949.       End If 
  950.       If Y>50
  951.         XX=Rnd(3)+253 : Y1=47+Rnd(Max(Y-50,0)) : Y2=47+Rnd(Max(Y-50,0))
  952.         Ink 1+Rnd(1)*6 : Draw XX,Min(Y1,Y2) To XX,Max(Y1,Y2)
  953.       End If 
  954.     End If 
  955.     Multi Wait 
  956.   Next 
  957.   If NWA<OWA
  958.     Ink 2
  959.     Draw 253,46 To 254,46
  960.     If Y>47
  961.       Bar 253,47 To 257,Y
  962.     Else 
  963.       Draw 253,47 To 258,47
  964.     End If 
  965.   End If 
  966.   OWA=NWA
  967.   Wait 25
  968.   If SOU Then Sam Loop Off : Sam Stop 
  969. Return 
  970. ZEIGPLANTAGE:
  971.   WINDO[21,3,39,16,%10,"Die Plantage von "+PL$(CP,0)]
  972.   Paste Bob 171,33,3
  973. Return 
  974. ZEIGOL:
  975.   WINDO[21,3,39,16,%10,"Der ï¿½lvorat"]
  976.   Paste Bob 171,33,5
  977. Return 
  978. SPIELLOAD:
  979.   Get Cblock 997,24,32,160,136
  980.   WINDO[3,4,23,21,%110,"Spielstand laden"]
  981.   FF$="Save/SavedGames.dat"
  982.   If Exist(FF$)=0
  983.     Ink 2 : Text 28,39+TB,"Keine Spielstande vorhanden!!!"
  984.     Wait 25
  985.     Put Cblock 997
  986.     Del Cblock 997
  987.     LOA=0 : Return 
  988.   End If 
  989.   For A=15 To 25
  990.     DISABLEICON[A]
  991.   Next 
  992.   Reserve As Work 10,400
  993.   Bload FF$,Start(10)
  994.   For A=0 To 9
  995.     SVGM$(A)=""
  996.     For D=0 To 39
  997.       P=Peek(Start(10)+A*40+D)
  998.       If P>0 Then SVGM$(A)=SVGM$(A)+Chr$(P)
  999.     Next 
  1000.   Next 
  1001.   Erase 10
  1002.   Ink 2 : Text 28,39+TB,"Welchen Spielstand laden?"
  1003.   Y=0
  1004.   For A=0 To 9
  1005.     If SVGM$(A)<>"" Then DEFGADGET[30+A,28,50+Y*10,179,58+Y*10,SVGM$(A)] : Inc Y
  1006.   Next 
  1007.   DEFGADGET[29,28,50+Y*10,179,58+Y*10,"Abbruch"]
  1008.   Repeat 
  1009.     Multi Wait 
  1010.     CLICKING : B=Param
  1011.   Until B>-1
  1012.   For A=0 To 10
  1013.     UNDEFICON[A+29]
  1014.   Next 
  1015.   For A=15 To 25
  1016.     ENABLEICON[A]
  1017.   Next 
  1018.   Put Cblock 997
  1019.   Del Cblock 997
  1020.   If B=29 Then LOA=0 : Return 
  1021.   F$="Save/SavedGame"+Str$(B-29)-" "+".ftc"
  1022.   If Exist(F$)=0 Then LOA=0 : Return 
  1023.   Open In 1,F$
  1024.     LE=Lof(1)
  1025.     Reserve As Work 9,LE
  1026.     ST=Start(9)
  1027.     Sload 1 To ST,LE
  1028.   Close 1
  1029.   A$="FTC-Save"
  1030.   For A=0 To 7
  1031.     If Peek(ST+A)<>Asc(Mid$(A$,A+1,1)) Then Erase 9 : LOA=0 : Return 
  1032.   Next 
  1033.   CK=0
  1034.   For A=ST To ST+LE-6 Step 2
  1035.     CK=(CK+Deek(A)) mod $10000
  1036.   Next 
  1037.   If Deek(ST+LE-4)<>$10000-CK Then Erase 9 : LOA=0 : Return 
  1038.   Add ST,8
  1039.   YEAR=Deek(ST)
  1040.   MON=Deek(ST+2)
  1041.   OP=Deek(ST+4)
  1042.   PL=Deek(ST+6) : Add ST,8
  1043.   For CP=0 To PL-1
  1044.     PL$(CP,0)=""
  1045.     For A=1 To 16
  1046.       If Peek(ST)>0 Then PL$(CP,0)=PL$(CP,0)+Chr$(Peek(ST))
  1047.       Inc ST
  1048.     Next 
  1049.     PL$(CP,1)=""
  1050.     For A=1 To 20
  1051.       If Peek(ST)>0 Then PL$(CP,1)=PL$(CP,1)+Chr$(Peek(ST))
  1052.       Inc ST
  1053.     Next 
  1054.     For A=0 To 35
  1055.       PL(CP,A)=Leek(ST) : Add ST,4
  1056.     Next 
  1057.     For A=0 To 15
  1058.       IN(CP,A,0)=Leek(ST)
  1059.       IN(CP,A,1)=Leek(ST+4)
  1060.       IN(CP,A,2)=Leek(ST+8) : Add ST,12
  1061.     Next 
  1062.     For Y=0 To 24
  1063.       For X=0 To 39
  1064.         F(CP,X,Y)=Peek(ST) : Inc ST
  1065.       Next 
  1066.     Next 
  1067.   Next 
  1068.   LOA=1
  1069.   CP=OP
  1070.   Erase 9
  1071. Return 
  1072. SPIELSAVE:
  1073.   Get Cblock 997,24,32,160,136
  1074.   WINDO[3,4,23,21,%110,"Spielstand speichern"]
  1075.   If Exist("Save")=0 Then Mkdir "Save"
  1076.   FF$="Save/SavedGames.dat"
  1077.   If Exist(FF$)=0
  1078.     Reserve As Work 10,400
  1079.   Else 
  1080.     Reserve As Work 10,400
  1081.     Bload FF$,Start(10)
  1082.   End If 
  1083.   For A=15 To 29
  1084.     DISABLEICON[A]
  1085.   Next 
  1086.   For A=0 To 9
  1087.     SVGM$(A)=""
  1088.     For D=0 To 39
  1089.       P=Peek(Start(10)+A*40+D)
  1090.       If P>0 Then SVGM$(A)=SVGM$(A)+Chr$(P)
  1091.     Next 
  1092.   Next 
  1093.   Ink 2 : Text 28,39+TB,"Welchen Spielstand speichern?"
  1094.   For A=0 To 9
  1095.     DEFGADGET[30+A,28,50+A*10,179,58+A*10,SVGM$(A)]
  1096.   Next 
  1097.   DEFGADGET[29,28,150,179,158,"Abbruch"]
  1098.   Repeat 
  1099.     Multi Wait 
  1100.     CLICKING : B=Param
  1101.   Until B>-1
  1102.   Ink 1
  1103.   If B>29
  1104.     D=B-30
  1105.     TEX$=SVGM$(D)
  1106.     EINGABE[30,50+D*10,40,37,0]
  1107.     If TEX$="" : TEX$="1. "+MON$(MON)+Str$(YEAR) : End If 
  1108.     SVGM$(D)=TEX$
  1109.     For A=0 To 39
  1110.       If A<Len(SVGM$(D))
  1111.         Poke Start(10)+D*40+A,Asc(Mid$(SVGM$(D),A+1,1))
  1112.       Else 
  1113.         Poke Start(10)+D*40+A,0
  1114.       End If 
  1115.     Next 
  1116.     Bsave FF$,Start(10) To Start(10)+400
  1117.   End If 
  1118.   Erase 10
  1119.   For A=0 To 10
  1120.     UNDEFICON[A+29]
  1121.   Next 
  1122.   For A=15 To 25
  1123.     ENABLEICON[A]
  1124.   Next 
  1125.   Put Cblock 997
  1126.   Del Cblock 997
  1127.   If B=29 Then Return 
  1128.   F$="Save/SavedGame"+Str$(B-29)-" "+".ftc"
  1129.   Reserve As Work 9,5500
  1130.   ST=Start(9)
  1131.   A$="FTC-Save"
  1132.   For A=1 To 8
  1133.     Poke ST,Asc(Mid$(A$,A,1)) : Inc ST
  1134.   Next 
  1135.   Doke ST,YEAR
  1136.   Doke ST+2,MON
  1137.   Doke ST+4,CP
  1138.   Doke ST+6,PL : Add ST,8
  1139.   OP=CP
  1140.   For CP=0 To PL-1
  1141.     For A=1 To 16
  1142.       If A<=Len(PL$(CP,0)) Then Poke ST,Asc(Mid$(PL$(CP,0),A,1)) Else Poke ST,0
  1143.       Inc ST
  1144.     Next 
  1145.     For A=1 To 20
  1146.       If A<=Len(PL$(CP,1)) Then Poke ST,Asc(Mid$(PL$(CP,1),A,1)) Else Poke ST,0
  1147.       Inc ST
  1148.     Next 
  1149.     For A=0 To 35
  1150.       Loke ST,PL(CP,A) : Add ST,4
  1151.     Next 
  1152.     For A=0 To 15
  1153.       Loke ST,IN(CP,A,0)
  1154.       Loke ST+4,IN(CP,A,1)
  1155.       Loke ST+8,IN(CP,A,2) : Add ST,12
  1156.     Next 
  1157.     For Y=0 To 24
  1158.       For X=0 To 39
  1159.         Poke ST,F(CP,X,Y) : Inc ST
  1160.       Next 
  1161.     Next 
  1162.   Next 
  1163.   CK=0
  1164.   For A=Start(9) To ST-2 Step 2
  1165.     CK=(CK+Deek(A)) mod $10000
  1166.   Next 
  1167.   Doke ST,$10000-CK : Add ST,4
  1168.   Bsave F$,Start(9) To ST
  1169.   Erase 9
  1170.   CP=OP : B=-1 : BB=-1
  1171. Return 
  1172. GAMEINIT:
  1173.   PL=B-1
  1174.   WINCLR[0,1,40,25]
  1175.   UNDEFICON[1]
  1176.   UNDEFICON[2]
  1177.   UNDEFICON[3]
  1178.   UNDEFICON[4]
  1179.   UNDEFICON[5]
  1180.   YEAR=1970 : MON=0
  1181.   Ink 2
  1182.   For CP=0 To PL-1
  1183.     Text 4,15+TB+CP*32,"Spieler"+Str$(CP+1)
  1184.     Text 12,23+TB+CP*32,"Name des Spielers:"
  1185.     TEX$=PL$(CP,0) : EINGABE[90,23+CP*32,20,15,0]
  1186.     If TEX$="" Then TEX$="Spieler"+Str$(CP+1)
  1187.     PL$(CP,0)=TEX$
  1188.     Text 12,31+TB+CP*32,"Name der Firma   :"
  1189.     TEX$=PL$(CP,1) : EINGABE[90,31+CP*32,25,20,0]
  1190.     If TEX$="" Then TEX$=PL$(CP,0)+" co."
  1191.     PL$(CP,1)=TEX$
  1192.   Next 
  1193.   WINCLR[0,1,40,25]
  1194.   Ink 2
  1195.   CT[80,"Bitte Warten..."]
  1196.   For CP=0 To PL-1
  1197.     Gosub RESETPLAYER
  1198.   Next 
  1199.   WINCLR[0,1,40,25]
  1200.   PAG=2 : CP=0 : Gosub UPDATSCREEN1
  1201. Return 
  1202. RESETPLAYER:
  1203.   PL(CP,0)=10000
  1204.   PL(CP,1)=500
  1205.   For B=2 To 5
  1206.     PL(CP,B)=0
  1207.   Next 
  1208.   For B=8 To 19
  1209.     PL(CP,B)=0
  1210.   Next 
  1211.   If CP=0 Then PL(CP,7)=Min(Rnd(7),6)
  1212.   PL(CP,10)=10
  1213.   PL(CP,11)=25
  1214.   For A=0 To 15
  1215.     IN(CP,A,0)=-1 : IN(CP,A,1)=-1 : IN(CP,A,2)=0
  1216.   Next 
  1217.   If CP=0 Then PL(CP,6)=PL(CP,7)*(Rnd(20)+10)
  1218.   Add PL(CP,1),PL(CP,6)
  1219.   Gosub COMPUTE2
  1220.   Gosub GENERATE
  1221. Return 
  1222. COMPUTE1:
  1223.   WINDO[1,3,39,24,%10,"Nachrichten an "+PL$(CP,0)]
  1224.   A$="30"
  1225.   If MON=1 Then A$="28"
  1226.   If MON=1 and(YEAR mod 4)=0 Then A$="29"
  1227.   If MON=0 or MON=2 or MON=4 or MON=6 or MON=7 or MON=9 or MON=11 Then A$="31"
  1228.   Ink 1 : Text 12,31+TB,A$+". "+MON$(MON)+Str$(YEAR)+"."
  1229.   Gosub INSECTS
  1230.   Y=38
  1231.   PL(CP,6)=PL(CP,7)*(Rnd(5)+5)
  1232.   R=PL(CP,6)*(1+PL(CP,17)+PL(CP,18))
  1233.   Add PL(CP,12),-Min(R,PL(CP,12))
  1234.   Add PL(CP,1),R
  1235.   RST=Max(PL(CP,18)-(PL(CP,19)*4),0)
  1236.   If PL(CP,12)>0 Then WE=Min((PL(CP,29)*100)/PL(CP,12),125) Else WE=150
  1237.   If PL(CP,13)>0 Then EF1=Min((PL(CP,8)*100)/PL(CP,13),150) Else EF1=100
  1238.   If PL(CP,14)>0 Then EF2=Min((PL(CP,9)*100)/PL(CP,14),150) Else EF2=100
  1239.   If PL(CP,19)>0 Then EF3=((PL(CP,18)-RST)*100)/(PL(CP,19)*4) Else EF3=100
  1240.   If PL(CP,30)<0 Then EF1=0
  1241.   If PL(CP,30)>0 Then EF2=0
  1242.   Gosub OTHEREVENTS
  1243.   P1=(Max(EF1+EF2-Rnd(50),0)*PL(CP,16)*(Rnd(5)+5))/5
  1244.   P2=(Max(EF1-Rnd(25),0)*WE*PL(CP,17)*(10-PL(CP,7)))/750
  1245.   P3=(Max(EF1-Rnd(10),0)*WE*RST*(9-PL(CP,7)))/1000
  1246.   P4=(Max(EF1+EF2-Rnd(25),0)*EF3*WE*PL(CP,19)*(10-PL(CP,7)))/40000
  1247.   L1=PL(CP,8)*PL(CP,10)
  1248.   L2=PL(CP,9)*PL(CP,11)
  1249.   If PL(CP,0)<0 Then L3=Abs((PL(CP,0)*4)/10) Else L3=0
  1250.   Add PL(CP,0),-(L1+L2+L3)
  1251.   Ink 2
  1252.   If VER Then Text 12,Y+TB,"Die Insekten haben sich vermehrt!" : Add Y,6
  1253.   If INS=1 Then Text 12,Y+TB,"Es ist nur ein Insektenschwarm auf Ihrem Grundst�ck!" : Add Y,6
  1254.   If INS>1 Then Text 12,Y+TB,"Es befinden sich"+Str$(INS)+" Insektenschw�rme auf Ihrem Grundst�ck!" : Add Y,6
  1255.   If DES=1 Then Text 12,Y+TB,"Au�erdem wurde ein Feld zerst�rt!" : Add Y,6
  1256.   If DES>1 Then Text 12,Y+TB,"Au�erdem wurden"+Str$(DES)+" Felder zerst�rt!" : Add Y,6
  1257.   If P1>0 and PL(CP,16)>1 Then Text 12,Y+TB,"Die ï¿½lt�rme konnten"+Str$(P1)+EH$(1)+" "+PRO$(1)+" f�rdern." : Add Y,6
  1258.   If P1>0 and PL(CP,16)=1 Then Text 12,Y+TB,"Der ï¿½lturm konnte"+Str$(P1)+EH$(1)+" "+PRO$(1)+" f�rdern." : Add Y,6
  1259.   If P2>0 Then Text 12,Y+TB,"Es wurden"+Str$(P2)+EH$(2)+" "+PRO$(2)+" geerntet." : Add Y,6
  1260.   If P3>0 Then Text 12,Y+TB,"Es wurden"+Str$(P3)+EH$(3)+" "+PRO$(3)+" geerntet." : Add Y,6
  1261.   If P4>0 Then Text 12,Y+TB,Str$(P4)-" "+" "+PRO$(4)+" konnten produziert werden." : Add Y,6
  1262.   Add PL(CP,2),P1
  1263.   Add PL(CP,3),P2
  1264.   Add PL(CP,4),P3
  1265.   Add PL(CP,5),P4
  1266.   If P1=0 and P2=0 and P3=0 and P4=0
  1267.     A$="Es wurde ï¿½berhaupt nichts produziert! " : B$=""
  1268.     If PL(CP,30)
  1269.       A$=A$+"Geben Sie halt den "
  1270.       If PL(CP,30)<0 : A$=A$+"Arbeitern" : Else A$=A$+"Facharbeitern" : End If 
  1271.       B$="Ihre Lohnerh�hung und Sie k�nnen wieder etwas produzieren!"
  1272.     Else 
  1273.       If PL(CP,17)+PL(CP,18)=0
  1274.         A$=A$+"Sie sollten endlich etwas anbauen!"
  1275.         If PL(CP,8)+PL(CP,9)=0
  1276.           B$="und dann Arbeiter einstellen!"
  1277.         End If 
  1278.       Else 
  1279.         If PL(CP,8)+PL(CP,9)=0
  1280.           A$=A$+"Sie sollten Arbeiter einstellen!"
  1281.         End If 
  1282.       End If 
  1283.     End If 
  1284.     Text 12,Y+TB,A$ : Add Y,6
  1285.     If B$<>"" : Text 12,Y+TB,B$ : Add Y,6 : End If 
  1286.   End If 
  1287.   If MON=11 Then L1=L1*2 : L2=L2*2
  1288.   If L1>0 and L2>0
  1289.     Text 12,Y+TB,"Die Ausgaben f�r die Arbeiter und Facharbeiter betrugen"+Str$(L1+L2)+" $." : Add Y,6
  1290.   Else 
  1291.     If L1>0
  1292.       Text 12,Y+TB,"Der Lohn f�r die Arbeiter betrug"+Str$(L1)+" $." : Add Y,6
  1293.     End If 
  1294.     If L2>0
  1295.       Text 12,Y+TB,"Der Lohn f�r die Facharbeiter betrug"+Str$(L1)+" $." : Add Y,6
  1296.     End If 
  1297.   End If 
  1298.   If MON=11 and L1+L2>0 Then Text 12,Y+TB,"(Inklusive Weihnachtsgeld.)" : Add Y,6
  1299.   If L3>0
  1300.     Text 12,Y+TB,"Abz�glich 4% Zins betr�gt "+PL$(CP,0)+"s Guthaben nun"+Str$(PL(CP,0))+" $." : Add Y,6
  1301.     If PL(CP,0)<-100000 : Gosub PFANDUNG : End If 
  1302.   Else 
  1303.     Text 12,Y+TB,"Ihr Guthaben betr�gt nun"+Str$(PL(CP,0))+" $." : Add Y,6
  1304.   End If 
  1305.   DISABLEICON[0]
  1306.   DEFGADGET[1,12,178,158,188,"Weiter"]
  1307.   DEFGADGET[2,160,178,307,188,"Karte anschauen"]
  1308.   Repeat 
  1309.     Multi Wait 
  1310.     CLICKING : B=Param
  1311.     If B=2 Then Gosub AFTERMAP
  1312.     BP=B : Gosub AUTOTEST
  1313.   Until B=1
  1314.   UNDEFICON[1]
  1315.   ENABLEICON[0]
  1316.   WINCLO[1,3,39,24]
  1317.   Inc CP
  1318.   If CP=PL
  1319.     CP=0
  1320.     Add MON,1,0 To 11
  1321.     If MON=0
  1322.       Inc YEAR
  1323.       If(YEAR and 2)=0
  1324.         For A=0 To PL-1
  1325.           Inc PL(A,15)
  1326.         Next 
  1327.       End If 
  1328.     End If 
  1329.   End If 
  1330. Return 
  1331. OTHEREVENTS:
  1332.   Ink 1
  1333.   If Rnd(150)=0 and PL(CP,0)>5000
  1334.     Text 12,Y+TB,"Achtung: In Ihrem B�ro wurde eingebrochen. Das ganze Geld aus Ihrem" : Add Y,6
  1335.     Text 12,Y+TB,"Safe wurde entwendet!" : Add Y,6
  1336.     PL(CP,0)=0
  1337.   End If 
  1338.   If Rnd(75)=0
  1339.     P=Rnd(9)*10000+10000
  1340.     Text 12,Y+TB,"Gl�ckwunsch: Sie haben im Lotto"+Str$(P)+" $ gewonnen!" : Add Y,6
  1341.     Add PL(CP,0),P
  1342.   End If 
  1343.   If Rnd(25)=0
  1344.     D=Rnd(2)
  1345.     If D=0 : A$="Zehn" : P=10 : End If 
  1346.     If D=1 : A$="Hundert" : P=100 : End If 
  1347.     If D=2 : A$="Tausend" : P=1000 : End If 
  1348.     Text 12,Y+TB,"Gl�ckwunsch: Sie haben einen "+A$+"-Dollar Schein gefunden!" : Add Y,6
  1349.     Add PL(CP,0),P
  1350.   End If 
  1351.   If Rnd(100)=0
  1352.     D=Rnd(3)
  1353.     P=Rnd(10000)*500+500
  1354.     If D=0 : A$="Ihrem Vater" : End If 
  1355.     If D=1 : A$="Ihrem Mutter" : End If 
  1356.     If D=2 : A$="Ihrer Tante" : End If 
  1357.     If D=3 : A$="Ihrem Onkel" : End If 
  1358.     Text 12,Y+TB,"Gl�ckwunsch: Sie erben von "+A$+Str$(P)+" $." : Add Y,6
  1359.     Add PL(CP,0),P
  1360.   End If 
  1361.   If Rnd(10)=0 and PL(CP,7)=6 Then Gosub FLOODING
  1362.   If Rnd(200)=0 Then Gosub ERDBEBEN
  1363.   D=Rnd(3)
  1364.   If Rnd(50)=0 and PL(CP,16+D)>0 Then Gosub ZERSTORGEBAUDE
  1365.   If Rnd(50)=0
  1366.     For A=0 To 15
  1367.       If IN(CP,A,0)=-1 : Exit : End If 
  1368.     Next 
  1369.     If A<16
  1370.       IN(CP,A,0)=Rnd(39) : IN(CP,A,1)=Rnd(24) : IN(CP,A,2)=10
  1371.       Text 12,Y+TB,"Achtung: Ein Insektenschwarm wurde auf Ihrem Gebiet gesichtet!" : Add Y,6
  1372.       Inc INS
  1373.     End If 
  1374.   End If 
  1375.   If Rnd(100)=0
  1376.     Text 12,Y+TB,"Achtung: Ein Atomkrieg bricht aus!" : Add Y,6
  1377.     Text 12,Y+TB,"Das Land wird von Atomraketen bombadiert!" : Add Y,6
  1378.     Wait 100
  1379.     Gosub AOMKRIEG
  1380.   End If 
  1381.   If Rnd(50)=0
  1382.     D=Rnd(2)
  1383.     P=Rnd(50)+10
  1384.     If D=0
  1385.       Text 12,Y+TB,"Achtung: Durch eine Grippewelle wurden"+Str$(P)+"% Ihrer Arbeiter" : Add Y,6
  1386.       Text 12,Y+TB,"und Facharbeiter krank."
  1387.     End If 
  1388.     If D=1
  1389.       Text 12,Y+TB,"Achtung: Durch ï¿½berm��igen Alkoholkonsum fallen"+Str$(P)+"% Ihrer" : Add Y,6
  1390.       Text 12,Y+TB,"Arbeiter und Facharbeiter aus."
  1391.     End If 
  1392.     If D=2
  1393.       Text 12,Y+TB,"Achtung: Durch eine Lebensmittelvergiftung k�nnen"+Str$(P)+"% Ihrer" : Add Y,6
  1394.       Text 12,Y+TB,"Arbeiter und Facharbeiter nicht kommen."
  1395.     End If 
  1396.     Add Y,6
  1397.     Add EF1,-((P*EF1)/100)
  1398.     Add EF2,-((P*EF2)/100)
  1399.   End If 
  1400.   D=Rnd(4)
  1401.   If Rnd(50)=0 and PL(CP,D+1)
  1402.     P=Rnd(60)+30
  1403.     If D=0
  1404.       B=0
  1405.       Text 12,Y+TB,"Achtung: Durch einen Bedienungsfehler wurden"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1406.       Text 12,Y+TB,"verschwendet."
  1407.     End If 
  1408.     If D=1
  1409.       B=Rnd(P+50)*500
  1410.       Text 12,Y+TB,"Achtung: Bei einer Explosion im ï¿½llager sind"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1411.       Text 12,Y+TB,"verbrannt. Schaden am Lager:"+Str$(B)+" $."
  1412.     End If 
  1413.     If D=2
  1414.       B=Rnd(P+50)*100
  1415.       Text 12,Y+TB,"Achtung:"+Str$(P)+"% Ihrer "+PRO$(D)+" wurden von Ratten aufgefressen." : Add Y,6
  1416.       Text 12,Y+TB,"Lohn f�r den Rattenf�nger:"+Str$(B)+" $."
  1417.     End If 
  1418.     If D=3
  1419.       B=Rnd(P+50)*200
  1420.       Text 12,Y+TB,"Achtung: Bei einem Feuer im Tabaklager wurden"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1421.       Text 12,Y+TB,"zerst�rt. Schaden am Lager:"+Str$(B)+" $."
  1422.     End If 
  1423.     If D=4
  1424.       B=Rnd(P+50)*300
  1425.       Text 12,Y+TB,"Achtung: Durch eine glimmende Zigarette wurde ein Feuer im Zigaretten-" : Add Y,6
  1426.       Text 12,Y+TB,"lager entfacht."+Str$(P)+"% Ihrer "+PRO$(D)+" wurden zerst�rt." : Add Y,6
  1427.       Text 12,Y+TB,"Schaden am Lager:"+Str$(B)+" $."
  1428.     End If 
  1429.     Add Y,6
  1430.     Add PL(CP,D+1),-(P*PL(CP,D+1)/100)
  1431.     Add PL(CP,0),-B
  1432.   End If 
  1433.   Ink 2
  1434. Return 
  1435. ZERSTORGEBAUDE:
  1436.   A$="Achtung: Durch ein Feuer wurde ein" : 
  1437.   If D=0
  1438.     Text 12,Y+TB,A$+" ï¿½lturm zerst�rt." : P=70
  1439.   End If 
  1440.   If D=1
  1441.     Text 12,Y+TB,A$+"e Dattelplantage zerst�rt." : P=67
  1442.   End If 
  1443.   If D=2
  1444.     Text 12,Y+TB,A$+"e Tabakplantage zerst�rt." : P=69
  1445.   End If 
  1446.   If D=3
  1447.     Text 12,Y+TB,A$+"e Zigarettenfabrik zerst�rt." : P=68
  1448.   End If 
  1449.   Add Y,6
  1450.   YY=Y
  1451.   For X=0 To 39
  1452.     For Y=0 To 24
  1453.       F=F(CP,X,Y)
  1454.       If F=P Then GX=X : GY=Y : F=66 : Gosub CHGBLOCK : Exit 2
  1455.     Next 
  1456.   Next 
  1457.   Y=YY
  1458. Return 
  1459. FLOODING:
  1460.   Text 12,Y+TB,"Achtung: Durch den starken Regenfall tritt der Flu� ï¿½ber die Ufer." : Add Y,6
  1461.   Text 12,Y+TB,"Alles in Ufern�he befindliche wird weggeschwemmt!" : Add Y,6
  1462.   YY=Y
  1463.   For X=0 To 39
  1464.     For Y=0 To 24
  1465.       F=F(CP,X,Y)
  1466.       If(F>1 and F<10) or(F>41 and F<66)
  1467.         If F>41
  1468.           F(CP,X,Y)=2+(F-42)/3
  1469.         End If 
  1470.         GX=X-1 : GY=Y-1 : Gosub FLOODBLK
  1471.         GX=X : GY=Y-1 : Gosub FLOODBLK
  1472.         GX=X+1 : GY=Y-1 : Gosub FLOODBLK
  1473.         GX=X+1 : GY=Y : Gosub FLOODBLK
  1474.         GX=X+1 : GY=Y+1 : Gosub FLOODBLK
  1475.         GX=X : GY=Y+1 : Gosub FLOODBLK
  1476.         GX=X-1 : GY=Y+1 : Gosub FLOODBLK
  1477.         GX=X-1 : GY=Y : Gosub FLOODBLK
  1478.       End If 
  1479.     Next 
  1480.   Next 
  1481.   Y=YY
  1482. Return 
  1483. FLOODBLK:
  1484.   If GX<0 or GX>39 or GY<0 or GY>24 Then Return 
  1485.   GF=F(CP,GX,GY)
  1486.   If(GF>1 and GF<10) or(GF>41 and GF<66) Then Return 
  1487.   If GF=67 Then Dec PL(CP,17)
  1488.   If GF=68 Then Dec PL(CP,19)
  1489.   If GF=69 Then Dec PL(CP,18)
  1490.   If GF=70 Then Dec PL(CP,16)
  1491.   F(CP,GX,GY)=Rnd(1)
  1492. Return 
  1493. AOMKRIEG:
  1494.   If MUS Then Call Start(12)+8 : Call Start(12)+4
  1495.   Sam Bank 6
  1496.   Hide On 
  1497.   OP=CP : YY=Y
  1498.   For CP=0 To PL-1
  1499.     Gosub NACHINITKARTE
  1500.     For A=0 To 14
  1501.       X=320 : Y=Rnd(22)+1
  1502.       TX=Rnd(35)+2 : H=12
  1503.       If SOU Then Sam Play 8,11
  1504.       Repeat 
  1505.         If Mouse Key=0 Then Wait Vbl 
  1506.         Sprite 2,X Hard(X),Y Hard(Y*8-H+4),50+(X and 1)
  1507.         Dec X : BX=X/8
  1508.         If BX<TX+2 Then Dec H
  1509.       Until H=0
  1510.       If SOU Then Sam Play 8,3
  1511.       For C=0 To 27
  1512.         Sprite 2,X Hard(X-4),Y Hard(Y*8-8),C+10
  1513.         Wait 3
  1514.       Next 
  1515.       F=66
  1516.       GX=TX : GY=Y : Gosub PASBLOCK
  1517.       GX=TX+1 : GY=Y : Gosub PASBLOCK
  1518.       GX=TX : GY=Y-1 : Gosub PASBLOCK
  1519.       GX=TX+1 : GY=Y-1 : Gosub PASBLOCK
  1520.       For C=15 To 0 Step -1
  1521.         Colour 31,$FF0+C : Wait 2
  1522.       Next 
  1523.       Sprite Off : Multi Wait 
  1524.       Colour 31,$FFF
  1525.     Next 
  1526.   Next 
  1527.   CP=OP : Y=YY
  1528.   Gosub NACHQUITKARTE
  1529.   Show On 
  1530.   Sam Bank 5
  1531.   If MUS Then Call Start(12)+6
  1532. Return 
  1533. ERDBEBEN:
  1534.   If PL(CP,19) or PL(CP,16)
  1535.     A$=""
  1536.     If PL(CP,19) : A$=A$+"Fabriken" : End If 
  1537.     If PL(CP,19)>0 and PL(CP,16)>0 : A$=A$+" und " : End If 
  1538.     If PL(CP,16) : A$=A$+"�lt�rme" : End If 
  1539.     Text 12,Y+TB,"Achtung: Durch ein Erdbeben wurden viele Ihrer "+A$ : Add Y,6
  1540.     Text 12,Y+TB,"v�llig zerst�rt." : Add Y,6
  1541.     YY=Y
  1542.     For Y=0 To 24
  1543.       For X=0 To 39
  1544.         F=F(CP,X,Y)
  1545.         If(F=68 or F=70) and Rnd(30)<24
  1546.           GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1547.         End If 
  1548.       Next 
  1549.     Next 
  1550.     Y=YY
  1551.     P=(PL(CP,19)+PL(CP,16))*10000
  1552.     Text 12,Y+TB,"Reparaturkosten anderer Geb�ude betragen"+Str$(P)+" $" : Add Y,6
  1553.     Add PL(CP,0),-P
  1554.   Else 
  1555.     Text 12,Y+TB,"Bei einem kleineren Erdbeben wurde nichts zerst�rt!" : Add Y,6
  1556.   End If 
  1557. Return 
  1558. AFTERMAP:
  1559.   Gosub NACHINITKARTE
  1560.   While Mouse Key=0 : Multi Wait : Wend 
  1561.   Gosub NACHQUITKARTE
  1562. Return 
  1563. NACHINITKARTE:
  1564.   Fade 1
  1565.   For A=0 To 16
  1566.     Colour Back Colour(0) : View : Wait Vbl 
  1567.   Next 
  1568.   Unpack 13 To 1 : Screen To Back 
  1569.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  1570.   Colour 16,0
  1571.   KART=-1 : Gr Writing 0
  1572.   Gosub INITKARTE
  1573. Return 
  1574. NACHQUITKARTE:
  1575.   Gosub QUITKARTE2
  1576.   Screen Close 2
  1577.   Screen Close 1
  1578.   Screen 0
  1579.   Fade 2 To -1
  1580.   For A=0 To 31
  1581.     Colour Back Colour(0) : View : Wait Vbl 
  1582.   Next 
  1583. Return 
  1584. PFANDUNG:
  1585.   Add Y,6
  1586.   If PL(CP,16)+PL(CP,17)+PL(CP,18)+PL(CP,19)=0 Then Pop : Goto GAMEOVER
  1587.   Ink 1 : Text 12,Y+TB,"Um Sie vor einem Bankrott zu bewahren, werden Sie gepf�ndet!"
  1588.   Add Y,6 : Ink 2
  1589.   For A=0 To 3
  1590.     If PL(CP,2+A)
  1591.       P=PL(CP,2+A)*PL(CP,21+A) : PL(CP,2+A)=0
  1592.       Add PL(CP,0),P
  1593.       If PL(CP,0)<0
  1594.         Text 12,Y+TB,PRO$(1+A)+" im Wert von"+Str$(P)+" $ verkauft. Restschuld"+Str$(-PL(CP,0))+" $."
  1595.       Else 
  1596.         Text 12,Y+TB,PRO$(1+A)+" im Wert von"+Str$(P)+" $ verkauft. Guthaben"+Str$(PL(CP,0))+" $."
  1597.       End If 
  1598.       Add Y,6
  1599.     End If 
  1600.     If PL(CP,0)>-10000
  1601.       Text 12,Y+TB+6,"Noch mal Schwein gehabt!" : Add Y,12
  1602.       Return 
  1603.     End If 
  1604.   Next 
  1605.   PM=PL(CP,15)*250
  1606.   A=1 : YY=Y
  1607.   Repeat 
  1608.     If A=1 and PL(CP,16)=0 Then Inc A
  1609.     If A=2 and PL(CP,19)=0 Then Inc A
  1610.     If A=3 and PL(CP,18)=0 Then Inc A
  1611.     For Y=0 To 24
  1612.       For X=0 To 39
  1613.         F=F(CP,X,Y)
  1614.         If F>66 and F<71
  1615.           If F=67 : A$="Eine Dattelplantage" : P=1500+PM : D=4 : End If 
  1616.           If F=68 : A$="Eine Zigarettenfabrik" : P=10000+PM : D=2 : End If 
  1617.           If F=69 : A$="Eine Tabakplantage" : P=2000+PM : D=3 : End If 
  1618.           If F=70 : A$="Ein ï¿½lturm" : P=15000+PM : D=1 : End If 
  1619.           If D=A
  1620.             GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1621.             Add PL(CP,0),P
  1622.             If PL(CP,0)<0
  1623.               B$=A$+" wurde f�r"+Str$(P)+" $ verkauft. Restschuld"+Str$(-PL(CP,0))+" $."
  1624.             Else 
  1625.               B$=A$+" wurde f�r"+Str$(P)+" $ verkauft. Guthaben"+Str$(PL(CP,0))+" $."
  1626.             End If 
  1627.             Gosub ST
  1628.           End If 
  1629.         End If 
  1630.         Exit If PL(CP,16)+PL(CP,17)+PL(CP,18)+PL(CP,19)=0 or PL(CP,0)>-10000,2
  1631.       Next 
  1632.     Next 
  1633.     Inc A
  1634.   Until A>4
  1635.   Y=YY
  1636.   If PL(CP,0)<-10000 Then Pop : Goto GAMEOVER
  1637.   B$="" : Gosub ST
  1638.   B$="Noch mal Schwein gehabt!" : Gosub ST
  1639.   Y=YY
  1640. Return 
  1641. ST:
  1642.   If YY>170
  1643.     Screen Copy 0,12,46,307,188 To 0,12,40
  1644.     Multi Wait : Add YY,-6
  1645.   End If 
  1646.   Text 12,YY+TB,B$ : Add YY,6
  1647. Return 
  1648. GAMEOVER:
  1649.   YY=Y
  1650.   B$="" : Gosub ST
  1651.   Ink 1 : B$="Schlechte Nachrichten, "+PL$(CP,0)+"! Sie sind bankrott!" : Gosub ST
  1652.   Ink 2 : B$="Sie d�rfen wieder von vorne anfangen." : Gosub ST
  1653.   B$="" : Gosub ST
  1654.   Ink 1 : B$="Bitte Warten..." : Gosub ST
  1655.   Gosub RESETPLAYER
  1656.   DISABLEICON[0]
  1657.   DEFGADGET[1,12,178,307,188,"Weiter"]
  1658.   Repeat 
  1659.     Multi Wait 
  1660.     CLICKING : B=Param
  1661.     BP=B : Gosub AUTOTEST
  1662.   Until B>-1
  1663.   UNDEFICON[1]
  1664.   ENABLEICON[0]
  1665.   WINCLO[1,3,39,24]
  1666.   Inc CP
  1667.   If CP=PL
  1668.     CP=0
  1669.     Add MON,1,0 To 11
  1670.     If MON=0 : Inc YEAR : End If 
  1671.     If(YEAR and 2)=0
  1672.       For A=0 To PL-1
  1673.         Inc PL(A,15)
  1674.       Next 
  1675.     End If 
  1676.   End If 
  1677.   B=-1
  1678. Return 
  1679. INSECTS:
  1680.   VER=0 : DES=0 : INS=0
  1681.   For A=0 To 15
  1682.     X=IN(CP,A,0) : Y=IN(CP,A,1) : FU=IN(CP,A,2)
  1683.     If FU>0
  1684.       F=F(CP,X,Y)
  1685.       If(F>1 and F<10) or(F>41 and F<66) : FU=Max(FU-10,0) : End If 
  1686.       If F>9 and F<42 : Add FU,5 : End If 
  1687.       If F=67 : Add FU,40 : End If 
  1688.       If F=69 : Add FU,25 : End If 
  1689.       If F>66 and F<71 : Inc DES : End If 
  1690.       If(F>9 and F<42) or(F>66 and F<71)
  1691.         GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1692.       End If 
  1693.       DD=999
  1694.       For GY=Max(Y-5,0) To Min(Y+5,24)
  1695.         For GX=Max(X-5,0) To Min(X+5,39)
  1696.           D=Abs(GX-X)+Abs(GY-Y)
  1697.           If F(CP,GX,GY)>66 and D<DD : XX=GX : YY=GY : DD=D : End If 
  1698.         Next 
  1699.       Next 
  1700.       If DD<999
  1701.         RX=Sgn(XX-X) : RY=Sgn(YY-Y)
  1702.       Else 
  1703.         RX=Rnd(2)-1 : RY=Rnd(2)-1
  1704.       End If 
  1705.       For D=0 To 19
  1706.         For DD=0 To 15
  1707.           If DD<>A and IN(CP,A,0)=IN(CP,DD,0) and IN(CP,A,1)=IN(CP,DD,1)
  1708.             RX=Rnd(2)-1 : RY=Rnd(2)-1
  1709.             Exit 
  1710.           End If 
  1711.         Next 
  1712.         Exit If DD=8
  1713.       Next 
  1714.       If FU>20
  1715.         For D=0 To 15
  1716.           If IN(CP,D,0)=-1
  1717.             FU=FU/2 : Inc VER
  1718.             IN(CP,D,0)=X : IN(CP,D,1)=Y : IN(CP,D,2)=-FU
  1719.             Exit 
  1720.           End If 
  1721.         Next 
  1722.       End If 
  1723.       Add X,RX : Add Y,RY : Add FU,-2
  1724.       IN(CP,A,0)=X : IN(CP,A,1)=Y : IN(CP,A,2)=FU
  1725.     End If 
  1726.   Next 
  1727.   For A=0 To 15
  1728.     If IN(CP,A,2)<0 Then IN(CP,A,2)=Abs(IN(CP,A,2))
  1729.     If IN(CP,A,0)<0 or IN(CP,A,0)>39 or IN(CP,A,1)<0 or IN(CP,A,1)>24 or IN(CP,A,2)<1
  1730.       IN(CP,A,0)=-1 : IN(CP,A,1)=-1 : IN(CP,A,2)=0
  1731.     Else 
  1732.       Inc INS
  1733.     End If 
  1734.   Next 
  1735. Return 
  1736. CHGBLOCK:
  1737.   GF=F(CP,GX,GY)
  1738.   If GF=67 Then Dec PL(CP,17)
  1739.   If GF=68 Then Dec PL(CP,19)
  1740.   If GF=69 Then Dec PL(CP,18)
  1741.   If GF=70 Then Dec PL(CP,16)
  1742.   F(CP,GX,GY)=F
  1743.   If F=67 Then Inc PL(CP,17)
  1744.   If F=68 Then Inc PL(CP,19)
  1745.   If F=69 Then Inc PL(CP,18)
  1746.   If F=70 Then Inc PL(CP,16)
  1747. Return 
  1748. COMPUTE2:
  1749.   If CP>0 Then Gosub COMPUTE3 : Return 
  1750.   PL(CP,7)=Min(Rnd(7),6)
  1751.   PL(CP,20)=7-PL(CP,7)
  1752.   Gosub COMPUTE3
  1753.   For B=25 To 28
  1754.     PL(CP,B)=(PL(CP,B)+Rnd(45)+5) mod 360
  1755.   Next 
  1756.   PL(CP,21)=Sin(PL(CP,25))*10+40
  1757.   PL(CP,22)=Sin(PL(CP,26))*3+9
  1758.   PL(CP,23)=Sin(PL(CP,27))*4+12
  1759.   PL(CP,24)=Sin(PL(CP,28))*5+16
  1760.   PL(CP,31)=(7-PL(CP,20))*(Rnd(15000)+7500)
  1761.   PL(CP,32)=(51-PL(CP,21))*(Rnd(150)+75)
  1762.   PL(CP,33)=(13-PL(CP,22))*(Rnd(1500)+750)
  1763.   PL(CP,34)=(16-PL(CP,23))*(Rnd(1000)+500)
  1764.   PL(CP,35)=(21-PL(CP,24))*(Rnd(750)+500)
  1765.   If PL=1 Then Return 
  1766.   For CP=1 To PL-1
  1767.     PL(CP,6)=PL(0,6)
  1768.     PL(CP,7)=PL(0,7)
  1769.     For B=20 To 28
  1770.       PL(CP,B)=PL(0,B)
  1771.     Next 
  1772.     For B=31 To 35
  1773.       PL(CP,B)=PL(0,B)
  1774.     Next 
  1775.     Gosub COMPUTE3
  1776.   Next 
  1777.   CP=0
  1778. Return 
  1779. COMPUTE3:
  1780.   PL(CP,13)=PL(CP,16)*30+PL(CP,17)*20+PL(CP,18)*30+PL(CP,19)*40
  1781.   PL(CP,14)=PL(CP,16)*25+PL(CP,19)*10
  1782.   PL(CP,1)=Min(PL(CP,1),100000)
  1783.   PL(CP,0)=Max(PL(CP,0),-9000000)
  1784.   PL(CP,12)=(PL(CP,17)*50+PL(CP,18)*30)*PL(CP,20)
  1785. Return 
  1786. UPDATSCREEN1:
  1787.   Sam Bank 5
  1788.   WINDO[1,3,20,16,%10,PL$(CP,1)]
  1789.   PASICON[1,3,30,107,32,24,"Ankauf"]
  1790.   PASICON[2,4,66,107,32,24,"Verkauf"]
  1791.   PASICON[3,5,102,107,32,24,"Weiter"]
  1792.   PASICON[9,8,138,107,32,24,"Optionen"]
  1793.   Ink 1 : Text 12,32+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  1794.   Ink 2
  1795.   If PL(CP,6)>0
  1796.     Text 12,40+TB,"Im "+MON$((MON+11) mod 12)+" sind"+Str$(PL(CP,6))+EH$(0)+"/ha Regen"
  1797.     Text 12,46+TB,"gefallen."
  1798.   Else 
  1799.     Text 12,40+TB,"Im "+MON$((MON+11) mod 12)+" hat es nicht geregnet!"
  1800.   End If 
  1801.   Text 12,54+TB,"Im Moment "+WET$(PL(CP,7))
  1802.   Gosub BENWASSER
  1803.   Text 12,62+TB,A$
  1804.   Text 12,68+TB,B$
  1805.   Text 12,74+TB,C$
  1806.   Gosub ZEIGPLANTAGE
  1807.   Gosub UPDATBESITZ
  1808.   Gosub UPDATPREISLISTE
  1809. Return 
  1810. BENWASSER:
  1811.   If PL(CP,12)>0
  1812.     A$="Um die"
  1813.     If PL(CP,17)>0
  1814.       A$=A$+Str$(PL(CP,17))+" ha "+PRO$(2)+" "
  1815.       If PL(CP,18)>0
  1816.         A$=A$+"und die"+Str$(PL(CP,18))+" ha"
  1817.         B$=PRO$(3)+" optimal bew�ssern zu k�nnen,"
  1818.         C$="werden"+Str$(PL(CP,12))+EH$(0)+" "+PRO$(0)+" ben�tigt."
  1819.       Else 
  1820.         A$=A$+"optimal be-"
  1821.         B$="w�ssern zu k�nnen, werden"+Str$(PL(CP,12))+EH$(0)
  1822.         C$=PRO$(0)+" ben�tigt."
  1823.       End If 
  1824.     Else 
  1825.       A$=A$+Str$(PL(CP,18))+" ha "+PRO$(3)+" optimal be-"
  1826.       B$="w�ssern zu k�nnen, werden"+Str$(PL(CP,12))+EH$(0)
  1827.       C$=PRO$(0)+" ben�tigt."
  1828.     End If 
  1829.   Else 
  1830.     A$="Zur Bew�sserung der Felder wird kein"
  1831.     B$=PRO$(0)+" ben�tigt!"
  1832.     C$=""
  1833.   End If 
  1834. Return 
  1835. UPDATPREISLISTE:
  1836.   WINDO[20,17,39,24,%10,"Preisliste"]
  1837.   Ink 1 : Text 164,143+TB,"        Verkaufspreis/Ankaufspreis"
  1838.   Ink 2
  1839.   Text 164,152+TB, Fn STL$(PRO$(0),12)+"              "+ Fn Z$(PL(CP,20),3)+" $"
  1840.   For A=1 To 4
  1841.     A$= Fn STL$(PRO$(A),12)+ Fn Z$(PL(CP,A+20),3)+" $         "+ Fn Z$((PL(CP,A+20)*6)/5,3)+" $"
  1842.     Text 164,152+A*7+TB,A$
  1843.   Next 
  1844.   Draw 164,151 To 306,151
  1845.   Draw 249,151 To 249,188
  1846. Return 
  1847. UPDATBESITZ:
  1848.   WINDO[1,17,19,24,%10,"Besitz"]
  1849.   Ink 2
  1850.   F$=Chr$(173)+Chr$(187)
  1851.   Text 12,144+TB,"Geld     "+ Fn Z$(PL(CP,0),9)+" $"
  1852.   Text 12,152+TB, Fn STL$(PRO$(0),9)+ Fn Z$(PL(CP,1),9)+EH$(0)
  1853.   For A=1 To 4
  1854.     A$= Fn STL$(PRO$(A),11)+ Fn Z$(PL(CP,A+1),7)+ Fn STL$(EH$(A),3)+" "+F$
  1855.     A$=A$+ Fn Z$(PL(CP,A+1)*PL(CP,A+20),8)+" $"
  1856.     Text 12,152+A*7+TB,A$
  1857.   Next 
  1858. Return 
  1859. RETWORKBENCH:
  1860.   If MUS=1 Then Call Start(12)+8 : Call Start(12)+4
  1861.   IS=-1 : TIMOUT=25
  1862.   For A=1 To 40
  1863.     UNDEFICON[A]
  1864.   Next 
  1865.   WINDO[0,1,40,25,%111111,"Workbench"]
  1866.   PASICON[1,2,16,32,15,14,"Spiele"]
  1867.   WINDO[10,5,30,20,%111111,"Spiele"]
  1868.   DEFICON[3,80,40,87,47]
  1869.   PASICON[2,1,160,100,64,48,"Free Trading Company"]
  1870.   PAG=0
  1871. Return 
  1872. GENERATE:
  1873.   L=0
  1874.   For Y=0 To 24
  1875.     For X=0 To 39
  1876.       F(CP,X,Y)=Rnd(1)
  1877.     Next 
  1878.   Next 
  1879.   Repeat 
  1880.     If Rnd(1)=0
  1881.       X=Rnd(1)*39 : Y=Rnd(17)+1
  1882.       If X=0 : RX=1 : Else RX=-1 : End If 
  1883.       RY=0
  1884.     Else 
  1885.       X=Rnd(39) : Y=Rnd(1)*24
  1886.       If Y=0 : RY=1 : Else RY=-1 : End If 
  1887.       RX=0
  1888.     End If 
  1889.     RXA=RX : RYA=RY : B=20
  1890.     Repeat 
  1891.       If RY Then A=Rnd(1)+2
  1892.       If RX Then A=Rnd(1)+4
  1893.       F(CP,X,Y)=A : C=0
  1894.       Repeat 
  1895.         F=0
  1896.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1897.         If F>1 Then B=Max(B-1,6)
  1898.         If Rnd(B)=1 or F>1
  1899.           R=Rnd(1)
  1900.           If R=0
  1901.             If RX
  1902.               RY=RX : RX=0
  1903.             Else 
  1904.               RX=-RY : RY=0
  1905.             End If 
  1906.           Else 
  1907.             If RX
  1908.               RY=-RX : RX=0
  1909.             Else 
  1910.               RX=RY : RY=0
  1911.             End If 
  1912.           End If 
  1913.         End If 
  1914.         F=0
  1915.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1916.         Inc C : If C>10 Then Exit 2
  1917.       Until F<2
  1918.       If RY<>RYA or RX<>RXA
  1919.         If(RYA=-1 and RX=1) or(RXA=-1 and RY=1) : A=6 : End If 
  1920.         If(RYA=-1 and RX=-1) or(RXA=1 and RY=1) : A=7 : End If 
  1921.         If(RYA=1 and RX=1) or(RXA=-1 and RY=-1) : A=8 : End If 
  1922.         If(RYA=1 and RX=-1) or(RXA=1 and RY=-1) : A=9 : End If 
  1923.       End If 
  1924.       B=Max(B-1,6)
  1925.       RXA=RX : RYA=RY : F(CP,X,Y)=A
  1926.       Add X,RX : Add Y,RY : Inc L
  1927.     Until X<0 or X>39 or Y<0 or Y>24
  1928.   Until L>30
  1929.   LL=L : L=0
  1930.   Repeat 
  1931.     Repeat 
  1932.       X=Rnd(37)+1
  1933.       Y=Rnd(22)+1
  1934.     Until F(CP,X,Y)<2
  1935.     If F(CP,X,Y)<2 Then F(CP,X,Y)=A
  1936.     F(CP,X,Y)=Rnd(1)+10
  1937.     RX=Rnd(1)*2-1 : RY=Rnd(1)*2-1
  1938.     Do 
  1939.       A=Rnd(1)+10 : F(CP,X,Y)=A : C=0
  1940.       Repeat 
  1941.         RX=Rnd(2)-1 : RY=Rnd(2)-1
  1942.         F=2
  1943.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1944.         Inc C : If C>10 Then Exit 2
  1945.       Until F<2
  1946.       Add X,RX : Add Y,RY : Inc L
  1947.     Loop 
  1948.   Until L>800-LL
  1949.   For Y=0 To 24
  1950.     For X=0 To 39
  1951.       F=F(CP,X,Y) : F2(X,Y)=F
  1952.       If X>0 Then F01=F(CP,X-1,Y)>9 Else F01=0
  1953.       If X<39 Then F21=F(CP,X+1,Y)>9 Else F21=0
  1954.       If Y>0 Then F10=F(CP,X,Y-1)>9 Else F10=0
  1955.       If Y<24 Then F12=F(CP,X,Y+1)>9 Else F12=0
  1956.       If F(CP,X,Y)<2 Then Gosub SMOOTHPLAIN
  1957.       If F(CP,X,Y)>1 and F(CP,X,Y)<10 Then Gosub SMOOTHRIVER
  1958.     Next 
  1959.   Next 
  1960.   For Y=0 To 24
  1961.     For X=0 To 39
  1962.       F(CP,X,Y)=F2(X,Y)
  1963.     Next 
  1964.   Next 
  1965. Return 
  1966. SMOOTHRIVER:
  1967.   If(F=2 or F=3) and(F01 or F21) Then F=38+F-F01*2-F21*4
  1968.   If(F=4 or F=5) and(F10 or F12) Then F=42+F-F12*2-F10*4
  1969.   If(F=6) and(F10 or F01) Then F=53-F10-F01*2
  1970.   If(F=7) and(F10 or F21) Then F=56-F10-F21*2
  1971.   If(F=8) and(F12 or F01) Then F=59-F01-F12*2
  1972.   If(F=9) and(F12 or F21) Then F=62-F21-F12*2
  1973.   F2(X,Y)=F
  1974. Return 
  1975. SMOOTHPLAIN:
  1976.   If X>0 and Y>0 Then F00=F(CP,X-1,Y-1)>9 Else F00=0
  1977.   If X<39 and Y>0 Then F20=F(CP,X+1,Y-1)>9 Else F20=0
  1978.   If X>0 and Y<24 Then F02=F(CP,X-1,Y+1)>9 Else F02=0
  1979.   If X<39 and Y<24 Then F22=F(CP,X+1,Y+1)>9 Else F22=0
  1980.   D=-F00-F20*2-F02*4-F22*8
  1981.   If D>0 Then F=26+D
  1982.   D=-F10-F01*2-F21*4-F12*8
  1983.   If D>0 Then F=11+D
  1984.   F2(X,Y)=F
  1985. Return 
  1986. QUIT:
  1987.   Pop 
  1988.   Fade 2
  1989.   For A=0 To 31
  1990.     Colour Back Colour(0) : View : Wait Vbl 
  1991.   Next 
  1992.   Screen Close 0
  1993.   Erase 5
  1994.   Erase 6
  1995. End 
  1996.  
  1997. MONATE:
  1998.   Data "Januar","Februar","M�rz","April","Mai","Juni","Juli","August"
  1999.   Data "September","Oktober","November","Dezember"
  2000.  
  2001. WETTER:
  2002.   Data "herrscht D�rre!","ist es sehr hei�.","ist es hei�."
  2003.   Data "ist es relativ warm.","ist es feucht."
  2004.   Data "regnet es oft.","regnet es in Str�men!"
  2005.  
  2006. PRODUKTE:
  2007.   Data "Wasser"," Hl","�l"," Ba","Datteln"," Kg"
  2008.   Data "Tabak"," Kg","Zigaretten"," St"
  2009.  
  2010. ANAUS:
  2011.   Data "aus","ein"
  2012.  
  2013. Procedure TITLE
  2014.   Hide On 
  2015.   Dim S1(2),S2(1),C2(3)
  2016.   Open In 1,"mod.title"
  2017.     Reserve As Chip Work 8,Lof(1)
  2018.     Sload 1 To Start(8),Lof(1)
  2019.     Loke Start(8)-8,$54726163
  2020.     Loke Start(8)-4,$6B657220
  2021.   Close 1
  2022.   Unpack 11 To 2 : Screen Hide 2
  2023.   For A=0 To 2 : S1(A)=Logbase(A) : Next 
  2024.   Unpack 7 To 1 : Screen Hide 1
  2025.   For A=0 To 58
  2026.     Get Block A+1,(A mod 20)*16,(A/20)*16,16,16
  2027.   Next 
  2028.   For A=0 To 3 : C2(A)=Colour(A) : Next 
  2029.   Screen Open 1,320,400,4,0 : Screen Hide 1
  2030.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  2031.   For A=0 To 1 : S2(A)=Logbase(A) : Next 
  2032.   Copper Off 
  2033.   Cop Reset 
  2034.   Cop Move $100,0
  2035.   Cop Wait $FE,$FF
  2036.   Cop Swap 
  2037.   Cop Reset 
  2038.   AD=Cop Logic
  2039.   SPR$=Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)
  2040.   Cop Move $100,0
  2041.   Cop Movel $EC,S2(0) : Rem 6
  2042.   Cop Movel $F0,S2(1) : Rem 14 
  2043.   Cop Movel $E0,S1(0)
  2044.   Cop Movel $E4,S1(1)
  2045.   Cop Movel $E8,S1(2)
  2046.   For A=0 To 7
  2047.     Cop Movel $120+A*4,Varptr(SPR$)
  2048.   Next 
  2049.   Cop Wait $0,$2E
  2050.   Cop Movel $102,0 : Rem    BPLCON1 BPLCON2   
  2051.   Cop Move $8E,$3081 : Rem  DIWSTRT   
  2052.   Cop Move $90,$F8C1 : Rem  DIWSTOP 
  2053.   Cop Move $92,$38 : Rem    DDFSTRT 
  2054.   Cop Move $94,$D0 : Rem    DFFSTOP 
  2055.   For A=0 To 3
  2056.     Cop Move $180+A*16,C2(A)
  2057.   Next 
  2058.   For A=1 To 7
  2059.     For B=0 To 3
  2060.       Cop Move $180+A*2+B*16,A*$222
  2061.     Next 
  2062.   Next 
  2063.   Cop Move $100,$5200 : Rem BLPCON0  
  2064.   Cop Move $96,$8180 : Rem  DMACON  
  2065.   Cop Wait $0,$7F
  2066.   For A=1 To 7
  2067.     Cop Move $180+A*2,A*$10
  2068.   Next 
  2069.   For A=1 To 3
  2070.     For B=0 To 7
  2071.       F1=Max(C2(A)/$100-B/2,0)
  2072.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2073.       F3=Max(C2(A) mod $10-B/2,0)
  2074.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2075.     Next 
  2076.   Next 
  2077.   Cop Wait $0,$90
  2078.   For A=1 To 7
  2079.     Cop Move $180+A*2,A*$110
  2080.   Next 
  2081.   For A=1 To 3
  2082.     For B=0 To 7
  2083.       F1=Min(C2(A)/$100+B/2,15)
  2084.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2085.       F3=Max(C2(A) mod $10-B/2,0)
  2086.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2087.     Next 
  2088.   Next 
  2089.   Cop Wait $0,$A0
  2090.   For A=1 To 7
  2091.     Cop Move $180+A*2,A*$11
  2092.   Next 
  2093.   For A=1 To 3
  2094.     For B=0 To 7
  2095.       F1=Max(C2(A)/$100-B/2,0)
  2096.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2097.       F3=Min(C2(A) mod $10+B/2,15)
  2098.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2099.     Next 
  2100.   Next 
  2101.   Cop Wait $0,$B0
  2102.   For A=1 To 7
  2103.     For B=0 To 3
  2104.       Cop Move $180+A*2+B*16,A*$222
  2105.     Next 
  2106.   Next 
  2107.   Cop Wait $FE,$FF
  2108.   Cop Swap 
  2109.   S$="WILLKOMMEN ZU##FREE TRADING COMPANY####EIN SPIEL VON##PETER HODGES #UND#CHRISTOPHER HODGES###"
  2110.   S$=S$+"KONZEPT UND DESIGN##PETER HODGES###PROGRAMM##CHRISTOPHER HODGES###"
  2111.   S$=S$+"GRAFIKEN##PETER HODGES###WEITERE GRAFIKEN##CHRISTOPHER HODGES###"
  2112.   S$=S$+"MUSIK UND SOUND##CHRISTOPHER HODGES###DOKUMENTATION##PETER HODGES###"
  2113.   S$=S$+"COPYRIGHT 1993##THE SOFTWARE SOCIETY##ALL RIGHTS RESERVED!#####"
  2114.   S$=S$+"VIEL SPASS!####DRUECKEN SIE DIE##LINKE MAUSTASTE!################"
  2115.   Track Loop On 
  2116.   Track Play 8
  2117.   BP=1
  2118.   YP=0
  2119.   Repeat 
  2120.     Timer=0
  2121.     COPL[AD+6,S2(0)+YP*40]
  2122.     COPL[AD+14,S2(1)+YP*40]
  2123.     Add YP,1,0 To 175
  2124.     If(YP mod 16)=0 Then Gosub PT Else Wait Vbl 
  2125.     If Timer<1 : Wait Vbl : End If 
  2126.   Until Mouse Key
  2127.   Copper On 
  2128.   Track Stop 
  2129.   Erase 8
  2130.   Screen Close 1
  2131.   Screen Close 2
  2132.   Show On 
  2133. Pop Proc
  2134. PT:
  2135.   A$=""
  2136.   Do 
  2137.     If BP=Len(S$) Then BP=1
  2138.     B$=Mid$(S$,BP,1)
  2139.     If B$="#" Then Exit 
  2140.     A$=A$+B$ : Inc BP
  2141.   Loop 
  2142.   Inc BP
  2143.   X=144-Len(A$)*8
  2144.   Ink 0 : Bar 0,YP To 319,YP+15
  2145.   Wait Vbl 
  2146.   If A$="" Then Ink 0 : Bar 0,YP+176 To 319,YP+191 : Return 
  2147.   For A=1 To Len(A$)
  2148.     Put Block Asc(Mid$(A$,A,1))-31,X+A*16,YP
  2149.   Next 
  2150.   Screen Copy 1,0,YP,319,YP+16 To 1,0,YP+176
  2151. Return 
  2152. End Proc
  2153. Procedure INITFONTS
  2154.   Get Disc Fonts 
  2155.   A=0 : FONT=0
  2156.   Repeat 
  2157.     Inc A
  2158.     If Instr(Upper$(Font$(A)),"FTC") Then FONT=A : Exit 
  2159.   Until Font$(A)=""
  2160.   If FONT=0
  2161.     Screen Open 0,320,200,2,0
  2162.     Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  2163.     Print "Error: FTC.font not found!"
  2164.     Print "Please copy the font onto your"
  2165.     Print "Harddisk!!!"
  2166.     Wait Key 
  2167.     Screen Close 0
  2168.     End 
  2169.   End If 
  2170.   TB=Text Base
  2171. End Proc
  2172. Procedure GRABICONS
  2173.   Unpack 14 To 0 : Screen Hide 0
  2174.   For A=0 To 70
  2175.     Get Cblock A+50,(A mod 40)*8,(A/40)*8,8,8
  2176.   Next 
  2177.   Screen Close 0
  2178.   Change Mouse 5
  2179.   Unpack 15 To 0 : Screen Hide 0
  2180.   For A=0 To 24
  2181.     Get Cblock A+1,A*8,0,8,8
  2182.   Next 
  2183.   Screen Close 0
  2184. End Proc
  2185. Procedure WINDO[X1,Y1,X2,Y2,FL,T$]
  2186.   XX1=X1*8 : YY1=Y1*8 : XX2=X2*8-8 : YY2=Y2*8-8
  2187.   Ink 0 : Bar XX1,YY1 To XX2+7,YY2+7
  2188.   If FL and 1
  2189.     Put Cblock 10,XX1,YY1
  2190.     Put Cblock 7,XX1+8,YY1
  2191.   Else 
  2192.     Put Cblock 7,XX1,YY1
  2193.     Put Cblock 8,XX1+8,YY1
  2194.   End If 
  2195.   If FL and 2
  2196.     If FL and 4
  2197.       Put Cblock 9,XX2-16,YY1
  2198.       Put Cblock 13,XX2-8,YY1
  2199.       Put Cblock 12,XX2,YY1
  2200.     Else 
  2201.       Put Cblock 8,XX2-16,YY1
  2202.       Put Cblock 9,XX2-8,YY1
  2203.       Put Cblock 12,XX2,YY1
  2204.     End If 
  2205.   Else 
  2206.     If FL and 4
  2207.       Put Cblock 8,XX2-16,YY1
  2208.       Put Cblock 9,XX2-8,YY1
  2209.       Put Cblock 13,XX2,YY1
  2210.     Else 
  2211.       Put Cblock 8,XX2-16,YY1
  2212.       Put Cblock 8,XX2-8,YY1
  2213.       Put Cblock 9,XX2,YY1
  2214.     End If 
  2215.   End If 
  2216.   For A=X1+2 To X2-4
  2217.     Put Cblock 8,A*8,YY1
  2218.   Next 
  2219.   For A=Y1+1 To Y2-1
  2220.     Put Cblock 2,XX1,A*8
  2221.   Next 
  2222.   If FL and 16
  2223.     A1=14 : A2=15 : A3=16 : EP=X2-5
  2224.   Else 
  2225.     A1=4 : A2=5 : A3=5 : EP=X2-3
  2226.   End If 
  2227.   Put Cblock A1,XX1,YY2
  2228.   For A=X1+1 To EP
  2229.     Put Cblock A2,A*8,YY2
  2230.   Next 
  2231.   Put Cblock A3,EP*8+8,YY2
  2232.   If FL and 16
  2233.     Put Cblock 17,EP*8+16,YY2
  2234.     Put Cblock 18,EP*8+24,YY2
  2235.   End If 
  2236.   If FL and 8
  2237.     Put Cblock 11,XX2,YY2
  2238.   Else 
  2239.     Put Cblock 6,XX2,YY2
  2240.   End If 
  2241.   If FL and 32
  2242.     A1=19 : A2=20 : A3=21 : EP=Y2-5
  2243.   Else 
  2244.     If FL and 8
  2245.       A1=24 : A2=24 : A3=24 : EP=Y2-3
  2246.     Else 
  2247.       A1=3 : A2=3 : A3=3 : EP=Y2-3
  2248.     End If 
  2249.   End If 
  2250.   Put Cblock A1,XX2,YY1+8
  2251.   For A=Y1+2 To EP
  2252.     Put Cblock A2,XX2,A*8
  2253.   Next 
  2254.   Put Cblock A3,XX2,EP*8+8
  2255.   If FL and 32
  2256.     Put Cblock 22,XX2,EP*8+16
  2257.     Put Cblock 23,XX2,EP*8+24
  2258.   End If 
  2259.   Ink 1
  2260.   If FL and 1
  2261.     Text XX1+10,YY1+TB,T$
  2262.   Else 
  2263.     Text XX1+2,YY1+TB,T$
  2264.   End If 
  2265. End Proc
  2266. Procedure WINCLR[X1,Y1,X2,Y2]
  2267.   Ink 0 : Bar X1*8+2,Y1*8+8 To X2*8-9,Y2*8-3
  2268. End Proc
  2269. Procedure WINCLO[X1,Y1,X2,Y2]
  2270.   Ink 0 : Bar X1*8,Y1*8 To X2*8-1,Y2*8-1
  2271. End Proc
  2272. Procedure PASICON[N,I,X1,Y1,X2,Y2,T$]
  2273.   GX=X2/2 : GY=Y2/2
  2274.   ICN(N,0)=X1-GX : ICN(N,1)=Y1-GY
  2275.   ICN(N,2)=X1-GX+X2-1 : ICN(N,3)=Y1-GY+Y2-1
  2276.   ICN(N,4)=I : ICN(N,5)=(Text Length(T$))/2
  2277.   Paste Icon X1-GX,Y1-GY,I
  2278.   Ink 1 : Text X1-ICN(N,5),Y1+GY+5,T$
  2279. End Proc
  2280. Procedure DEFICON[N,X1,Y1,X2,Y2]
  2281.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2282.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2283. End Proc
  2284. Procedure DEFGADGET[N,X1,Y1,X2,Y2,T$]
  2285.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2286.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2287.   Ink 1 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  2288.   Ink 2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  2289.   Text(X1+X2)/2-(Text Length(T$))/2,(Y1+Y2)/2+TB/2-1,T$
  2290. End Proc
  2291. Procedure DEFGADGET2[N,X1,Y1,X2,Y2,T$]
  2292.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2293.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2294.   Ink 31 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  2295.   Ink 20 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  2296.   Text(X1+X2)/2-(Text Length(T$))/2,(Y1+Y2)/2+TB/2-1,T$
  2297. End Proc
  2298. Procedure PRESSICON[N]
  2299.   X1=ICN(N,0) : Y1=ICN(N,1)
  2300.   X2=ICN(N,2) : Y2=ICN(N,3)
  2301.   Screen Copy Screen,X1,Y1,X2+1,Y2+1 To Screen,X1,Y1,%110000
  2302. End Proc
  2303. Procedure UNDEFICON[N]
  2304.   ICN(N,0)=0 : ICN(N,1)=0
  2305.   ICN(N,2)=0 : ICN(N,3)=0
  2306. End Proc
  2307. Procedure DISABLEICON[N]
  2308.   ICN(N,2)=-Abs(ICN(N,2))
  2309.   ICN(N,3)=-Abs(ICN(N,3))
  2310. End Proc
  2311. Procedure ENABLEICON[N]
  2312.   ICN(N,2)=Abs(ICN(N,2))
  2313.   ICN(N,3)=Abs(ICN(N,3))
  2314. End Proc
  2315. Procedure ERAICON[N]
  2316.   Ink 0 : Bar ICN(N,0),ICN(N,1) To ICN(N,2),ICN(N,3)
  2317.   MX=(ICN(N,0)+ICN(N,2))/2
  2318.   Bar MX-ICN(N,5),ICN(N,3)+2 To MX+ICN(N,5),ICN(N,3)+6
  2319.   ICN(N,0)=0 : ICN(N,1)=0
  2320.   ICN(N,2)=0 : ICN(N,3)=0
  2321. End Proc
  2322. Procedure CHECKICONS[X,Y]
  2323.   BB=-1
  2324.   For A=0 To 40
  2325.     If ICN(A,0)<X and ICN(A,2)>X and ICN(A,1)<Y and ICN(A,3)>Y Then BB=A : Exit 
  2326.   Next 
  2327. End Proc[BB]
  2328. Procedure ALERT[TI$,T1$,T2$,YES$,NO$]
  2329.   Get Cblock 999,0,0,128,56
  2330.   WINDO[0,0,16,7,%1110,TI$]
  2331.   Ink 1
  2332.   Text 60-(Text Length(T1$))/2,10+TB,T1$
  2333.   Text 60-(Text Length(T2$))/2,16+TB,T2$
  2334.   For A=0 To 40
  2335.     DISABLEICON[A]
  2336.   Next 
  2337.   DEFGADGET[39,10,32,56,48,YES$]
  2338.   DEFGADGET[40,64,32,110,48,NO$]
  2339.   Repeat 
  2340.     Wait Vbl : CLICKING : B=Param
  2341.   Until B>-1
  2342.   Put Cblock 999
  2343.   Del Cblock 999
  2344.   UNDEFICON[39]
  2345.   UNDEFICON[40]
  2346.   For A=0 To 40
  2347.     ENABLEICON[A]
  2348.   Next 
  2349. End Proc[40-B]
  2350. Procedure CLICKING
  2351.   X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  2352.   B=-1
  2353.   If M>1 and PAG<>4 Then Ink 2 : Bar 0,0 To 319,7 : UP=198
  2354.   If M=1 Then CHECKICONS[X,Y] : B=Param
  2355.   If B>-1
  2356.     If SOU>0 and PAG>0 : Sam Play 8,1 : End If 
  2357.     IS=0
  2358.     While M=1
  2359.       Wait Vbl : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  2360.       CHECKICONS[X,Y]
  2361.       If Param=B and IS=0 : IS=1 : PRESSICON[B] : End If 
  2362.       If Param<>B and IS=1 : IS=0 : PRESSICON[B] : End If 
  2363.     Wend 
  2364.     If IS=0
  2365.       B=-1
  2366.     Else 
  2367.       PRESSICON[B]
  2368.     End If 
  2369.   End If 
  2370. End Proc[B]
  2371. Procedure CT[Y,T$]
  2372.   Text 160-(Text Length(T$))/2,Y+TB,T$
  2373. End Proc
  2374. Procedure OT[X,Y,C1,C2,T$]
  2375.   Ink C2 : Text X-1,Y,T$ : Text X-1,Y-1,T$ : Text X,Y-1,T$
  2376.   Text X+1,Y-1,T$ : Text X+1,Y,T$ : Text X+1,Y+1,T$
  2377.   Text X,Y+1,T$ : Text X-1,Y+1,T$
  2378.   Ink C1 : Text X,Y,T$
  2379. End Proc
  2380. Procedure EINGABE[TX,TY,WX,MC,NUMS]
  2381.   Gr Writing 1 : Ink 2,0 : Clear Key 
  2382.   TEXX=Len(TEX$) : TEXOF=0 : ALT$="x" : RET=0
  2383.   Do 
  2384.     Multi Wait : I$=Inkey$ : AC=Asc(I$) : SC=Scancode : KS=Key Shift
  2385.     If AC=13 Then RET=1
  2386.     Exit If AC=13 or AC=27
  2387.     If(NUMS and 1) and AC>31 and(AC<48 or AC>57) Then AC=0
  2388.     If AC>31 and Len(TEX$)<MC Then TEX$=Left$(TEX$,TEXX)+I$+Mid$(TEX$,TEXX+1) : Inc TEXX
  2389.     If SC=65 and KS=0 and TEXX>0 Then TEX$=Left$(TEX$,TEXX-1)+Mid$(TEX$,TEXX+1) : Dec TEXX
  2390.     If SC=70 and KS=0 and TEXX<Len(TEX$) Then TEX$=Left$(TEX$,TEXX)+Mid$(TEX$,TEXX+2)
  2391.     If SC=65 and KS and TEXX>0 Then TEX$=Mid$(TEX$,TEXX+1) : TEXX=0
  2392.     If SC=70 and KS and TEXX<Len(TEX$) Then TEX$=Left$(TEX$,TEXX) : TEXX=Len(TEX$)
  2393.     If AC=29 and TEXX>0 Then Dec TEXX
  2394.     If AC=28 and TEXX<Len(TEX$) Then Inc TEXX
  2395.     If SC=79 and KS Then TEXX=0
  2396.     If SC=78 and KS Then TEXX=Len(TEX$)
  2397.     If TEXX-TEXOF>WX-1 Then TEXOF=TEXX-WX+1
  2398.     If TEXX-TEXOF<0 Then TEXOF=Max(0,TEXX)
  2399.     If(ALT$<>TEX$) or(ALTOF<>TEXOF) or(ALTXX<>TEXX)
  2400.       If SOU : Sam Play 8,5 : End If 
  2401.       ALT$=TEX$ : ALTOF=TEXOF : ALTXX=TEXX
  2402.       Text TX,TY+6,Mid$(TEX$,TEXOF+1,Min(Len(TEX$)+TEXOF,WX))+String$(".",Max(0,Min(WX,MC)-Len(TEX$)+TEXOF))
  2403.       XX=TX+TEXX*4-TEXOF*4
  2404.       If TEXX-TEXOF<MC : Screen Copy 0,XX,TY+2,XX+4,TY+8 To 0,XX,TY+2,%110000 : End If 
  2405.     End If 
  2406.   Loop 
  2407.   If NUMS and 1 Then TEX$=Str$(Val(TEX$))-" "
  2408.   Text TX,TY+TB,Left$(TEX$,Min(Len(TEX$),WX))+Space$(Max(0,Min(WX,MC)-Len(TEX$)))
  2409.   If SOU : Sam Play 8,1 : End If 
  2410.   Wait Vbl 
  2411.   Gr Writing 0
  2412. End Proc[RET]
  2413. Procedure COPL[ADR,V]
  2414.   Doke ADR,V/$10000
  2415.   Doke ADR+4,V and $FFFF
  2416. End Proc
  2417. Procedure S1
  2418.   For Y=0 To WY+S Step S
  2419.     Screen Copy B1,0,Y,WX,Y+S To B2,0,Y : Wait Vbl 
  2420.   Next 
  2421. End Proc
  2422. Procedure S2
  2423.   For Y=WY To -S Step -S
  2424.     Screen Copy B1,0,Y,WX,Y+S To B2,0,Y : Wait Vbl 
  2425.   Next 
  2426. End Proc
  2427. Procedure S3
  2428.   For X=0 To WX+S Step S
  2429.     Screen Copy B1,X,0,X+S,WY To B2,X,0 : Wait Vbl 
  2430.   Next 
  2431. End Proc
  2432. Procedure S4
  2433.   For X=WX To -S Step -S
  2434.     Screen Copy B1,X,0,X+S,WY To B2,X,0 : Wait Vbl 
  2435.   Next 
  2436. End Proc
  2437. Procedure S5
  2438.   For YY=0 To S-1
  2439.     For Y=0 To WY+S Step S
  2440.       Screen Copy B1,0,Y+YY,WX,Y+YY+1 To B2,0,Y+YY
  2441.     Next 
  2442.     Wait Vbl 
  2443.   Next 
  2444. End Proc
  2445. Procedure S6
  2446.   For YY=S-1 To 0 Step -1
  2447.     For Y=WY To -S Step -S
  2448.       Screen Copy B1,0,Y+YY,WX,Y+YY+1 To B2,0,Y+YY
  2449.     Next 
  2450.     Wait Vbl 
  2451.   Next 
  2452. End Proc
  2453. Procedure S7
  2454.   For XX=0 To S-1
  2455.     For X=0 To WX+S Step S
  2456.       Screen Copy B1,X+XX,0,X+XX+1,WY To B2,X+XX,0
  2457.     Next 
  2458.     Wait Vbl 
  2459.   Next 
  2460. End Proc
  2461. Procedure S8
  2462.   For XX=S-1 To 0 Step -1
  2463.     For X=WX To -S Step -S
  2464.       Screen Copy B1,X+XX,0,X+XX+1,WY To B2,X+XX,0
  2465.     Next 
  2466.     Wait Vbl 
  2467.   Next 
  2468. End Proc
  2469. Procedure S9
  2470.   B=0 : A=0 : X=0 : Y=0 : RX=16 : RY=0 : BX1=-16 : BX2=WX-16 : BY1=0 : BY2=WY+8
  2471.   Repeat 
  2472.     Screen Copy B1,X,Y,X+16,Y+16 To B2,X,Y : Add B,1,0 To 3 : If B=0 Then Wait Vbl 
  2473.     If Y+RY<BY1 and A=3 Then Add A,1,0 To 3 : RY=0 : RX=16 : Add BX2,-16
  2474.     If X+RX<BX1 and A=2 Then Add A,1,0 To 3 : RX=0 : RY=-16 : Add BY1,16
  2475.     If Y+RY>BY2 and A=1 Then Add A,1,0 To 3 : RY=0 : RX=-16 : Add BX1,16
  2476.     If X+RX>BX2 and A=0 Then Add A,1,0 To 3 : RX=0 : RY=16 : Add BY2,-16
  2477.     Add X,RX : Add Y,RY
  2478.   Until BX2<=BX1 or BY2<BY1
  2479. End Proc
  2480. Procedure S10
  2481.   X=0 : Y=0 : RY=16 : A=0
  2482.   Repeat 
  2483.     Screen Copy B1,X,Y,X+16,Y+16 To B2,X,Y : Add A,1,0 To 3 : If A=0 Then Wait Vbl 
  2484.     If Y>WY or Y<0 Then RY=-RY : Add X,16
  2485.     Add Y,RY
  2486.   Until X>WX
  2487. End Proc
  2488. Procedure S11
  2489.   Dim F(WX/S) : B=WX/S
  2490.   Repeat 
  2491.     Repeat : A=Rnd(WX/S-1) : Until F(A)<WY
  2492.     C=Rnd(S)+1
  2493.     Screen Copy B1,A*S,F(A),A*S+S,F(A)+C To B2,A*S,F(A)
  2494.     Add F(A),C : If F(A)=>WY Then Dec B
  2495.   Until B=0
  2496. End Proc
  2497. Procedure S12
  2498.   Dim F(WX/S) : B=WX/S
  2499.   For A=0 To WX/S
  2500.     F(A)=WY
  2501.   Next 
  2502.   Repeat 
  2503.     Repeat : A=Rnd(WX/S-1) : Until F(A)>0
  2504.     C=Rnd(S)+1
  2505.     Add F(A),-C
  2506.     Screen Copy B1,A*S,F(A),A*S+S,F(A)+C To B2,A*S,F(A)
  2507.     If F(A)<1 Then Dec B
  2508.   Until B=0
  2509. End Proc
  2510. Procedure S13
  2511.   For Y=0 To 400 Step S
  2512.     For X=0 To WX/64-1
  2513.       YY=Y-(4-X)*32
  2514.       Screen Copy B1,X*64,YY,X*64+64,YY+S To B2,X*64,YY
  2515.     Next 
  2516.     Wait Vbl 
  2517.   Next 
  2518. End Proc
  2519. Procedure S14
  2520.   For Y=0 To 408 Step S
  2521.     For X=0 To WX/16-1
  2522.       Screen Copy B1,X*16,Y-X*8,X*16+16,Y-X*8+S To B2,X*16,Y-X*8
  2523.     Next 
  2524.     Wait Vbl 
  2525.   Next 
  2526. End Proc